diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 1c5d3ca67..5118093da 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -17,7 +17,11 @@ module Ensemble_driver public :: SetServices private :: SetModelServices + private :: ensemble_finalize + integer, allocatable :: asyncio_petlist(:) + logical :: asyncio_task=.false. + logical :: asyncIO_available=.false. character(*),parameter :: u_FILE_u = & __FILE__ @@ -27,9 +31,12 @@ module Ensemble_driver subroutine SetServices(ensemble_driver, rc) - use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSpecialize + use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSpecialize, NUOPC_CompAttributeSet + use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Driver , only : driver_routine_SS => SetServices use NUOPC_Driver , only : ensemble_label_SetModelServices => label_SetModelServices + use NUOPC_Driver , only : ensemble_label_ModifyCplLists => label_ModifyCplLists + use NUOPC_Driver, only : label_Finalize use ESMF , only : ESMF_GridComp, ESMF_GridCompSet use ESMF , only : ESMF_Config, ESMF_ConfigCreate, ESMF_ConfigLoadFile use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO @@ -39,7 +46,8 @@ subroutine SetServices(ensemble_driver, rc) ! local variables type(ESMF_Config) :: config - character(len=*), parameter :: subname = "(ensemble_driver.F90:SetServices)" + logical :: isPresent ! Check to see if InitializeDataResolution attribute is available + character(len=*), parameter :: subname = '('//__FILE__//':SetServices)' !--------------------------------------- rc = ESMF_SUCCESS @@ -54,6 +62,14 @@ subroutine SetServices(ensemble_driver, rc) specRoutine=SetModelServices, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! ModifyCplLists is a NUOPC specialization which happens after Advertize but before Realize + ! We have overloaded this specialization location to initilize IO. + ! So after all components have called Advertise but before any component calls Realize + ! IO will be initialized and any async IO tasks will be split off to the PIO async IO driver. + call NUOPC_CompSpecialize(ensemble_driver, specLabel=ensemble_label_ModifyCplLists, & + specRoutine=InitializeIO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Create, open and set the config config = ESMF_ConfigCreate(rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -64,6 +80,25 @@ subroutine SetServices(ensemble_driver, rc) call ESMF_GridCompSet(ensemble_driver, config=config, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! NUOPC component drivers end the initialization process with an internal call to InitializeDataResolution. + ! The ensemble_driver does not need to InitializeDataResolution and doing so will cause a hang + ! if asyncronous IO is used. This attribute is available after ESMF8.4.0b03 to toggle that control. + ! Cannot use asyncIO with older ESMF versions. + call NUOPC_CompAttributeGet(ensemble_driver, name="InitializeDataResolution", & + isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if(isPresent) then + call NUOPC_CompAttributeSet(ensemble_driver, name="InitializeDataResolution", value="false", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + asyncIO_available = .true. + endif + ! Set a finalize method, it calls pio_finalize + call NUOPC_CompSpecialize(ensemble_driver, specLabel=label_Finalize, & + specRoutine=ensemble_finalize, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine SetServices @@ -90,22 +125,27 @@ subroutine SetModelServices(ensemble_driver, rc) ! local variables type(ESMF_VM) :: vm - type(ESMF_GridComp) :: driver, gridcomptmp + type(ESMF_GridComp) :: driver type(ESMF_Config) :: config integer :: n, n1, stat integer, pointer :: petList(:) character(len=20) :: model, prefix - integer :: petCount, i + integer :: petCount, i, k integer :: localPet logical :: is_set character(len=512) :: diro character(len=512) :: logfile integer :: global_comm logical :: read_restart + logical :: comp_task character(len=CS) :: read_restart_string integer :: inst + integer :: currentpet, petcnt, iopetcnt integer :: number_of_members integer :: ntasks_per_member + integer :: pio_asyncio_ntasks + integer :: pio_asyncio_stride + integer :: pio_asyncio_rootpe character(CL) :: start_type ! Type of startup character(len=7) :: drvrinst character(len=5) :: inst_suffix @@ -115,7 +155,7 @@ subroutine SetModelServices(ensemble_driver, rc) character(len=*) , parameter :: start_type_start = "startup" character(len=*) , parameter :: start_type_cont = "continue" character(len=*) , parameter :: start_type_brnch = "branch" - character(len=*) , parameter :: subname = "(ensemble_driver.F90:SetModelServices)" + character(len=*), parameter :: subname = '('//__FILE__//':SetModelServices)' !------------------------------------------- rc = ESMF_SUCCESS @@ -168,6 +208,8 @@ subroutine SetModelServices(ensemble_driver, rc) write(read_restart_string,*) read_restart ! Add read_restart to ensemble_driver attributes + + call ESMF_LogWrite(trim(subname)//": set read_restart "//trim(read_restart_string), ESMF_LOGMSG_INFO) call NUOPC_CompAttributeAdd(ensemble_driver, attrList=(/'read_restart'/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeSet(ensemble_driver, name='read_restart', value=trim(read_restart_string), rc=rc) @@ -187,40 +229,93 @@ subroutine SetModelServices(ensemble_driver, rc) call NUOPC_CompAttributeGet(ensemble_driver, name="ninst", value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) number_of_members + + call NUOPC_CompAttributeGet(ensemble_driver, name="pio_asyncio_ntasks", value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) pio_asyncio_ntasks + + call NUOPC_CompAttributeGet(ensemble_driver, name="pio_asyncio_stride", value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) pio_asyncio_stride + + call NUOPC_CompAttributeGet(ensemble_driver, name="pio_asyncio_rootpe", value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) pio_asyncio_rootpe call ESMF_VMGet(vm, localPet=localPet, PetCount=PetCount, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + + ntasks_per_member = PetCount/number_of_members - pio_asyncio_ntasks - ntasks_per_member = PetCount/number_of_members - if(ntasks_per_member*number_of_members .ne. PetCount) then + if(ntasks_per_member*number_of_members .ne. (PetCount - pio_asyncio_ntasks)) then write (msgstr,'(a,i5,a,i3,a,i3,a)') & - "PetCount (",PetCount,") must be evenly divisable by number of members (",number_of_members,")" + "PetCount - Async IOtasks (",PetCount-pio_asyncio_ntasks,") must be evenly divisable by number of members (",number_of_members,")" call ESMF_LogSetError(ESMF_RC_ARG_BAD, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) return endif + if(pio_asyncio_ntasks > 0 .and. .not. asyncIO_available) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, msg="AsyncIO requires ESMF version 8.4.0b03 or newer", line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + !------------------------------------------- ! Loop over number of ensemblel members !------------------------------------------- allocate(petList(ntasks_per_member)) + ! Create an asyncio petlist (a list of Pets who will be dedicated to IO). All components + ! with async IO enabled will use these IO PETS. If stride = MPI_TASKS_PER_NODE then there will + ! be one IO task per node. + allocate(asyncio_petlist(pio_asyncio_ntasks)) + iopetcnt = 1 + currentPet = 0 + + do n=1,pio_asyncio_ntasks + asyncio_petlist(n) = pio_asyncio_rootpe + (n-1)*pio_asyncio_stride + if (localPet == asyncio_petlist(n)) asyncio_task = .true. + enddo + k = 1 do inst=1,number_of_members - + petcnt=1 + comp_task = .false. ! Determine pet list for driver instance - petList(1) = (inst-1) * ntasks_per_member - do n=2,ntasks_per_member - petList(n) = petList(n-1) + 1 + do n=1,ntasks_per_member+pio_asyncio_ntasks + if(pio_asyncio_stride == 0) then + petList(petcnt) = currentpet + petcnt = petcnt+1 + if (currentpet == localPet) comp_task=.true. + else if(pio_asyncio_stride == 1) then + if (currentpet < asyncio_petlist(1) .or. currentpet > asyncio_petlist(pio_asyncio_ntasks)) then + petList(petcnt) = currentpet + petcnt = petcnt+1 + if (currentpet == localPet) comp_task=.true. + endif + else if (currentpet .ne. asyncio_petlist(k)) then + petList(petcnt) = currentpet + petcnt = petcnt+1 + if (currentpet == localPet) comp_task=.true. + else if (currentpet == asyncio_petlist(k)) then + k = modulo(k,pio_asyncio_ntasks) + 1 + endif + currentpet = currentpet + 1 enddo + if(asyncio_task .and. comp_task) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, msg="task is set as both a compute task and an asyncio task", line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif ! Add driver instance to ensemble driver write(drvrinst,'(a,i4.4)') "ESM",inst - call NUOPC_DriverAddComp(ensemble_driver, drvrinst, ESMSetServices, petList=petList, comp=gridcomptmp, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (localpet >= petlist(1) .and. localpet <= petlist(ntasks_per_member)) then - - driver = gridcomptmp + call NUOPC_DriverAddComp(ensemble_driver, drvrinst, ESMSetServices, petList=petList, comp=driver, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) then + write(msgstr,*) 'size(petList):', size(petList), ' petcnt:', petcnt, ' petList: ',petList + call ESMF_LogSetError(ESMF_RC_ARG_BAD, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + mastertask = .false. + if (comp_task) then if(number_of_members > 1) then call NUOPC_CompAttributeAdd(driver, attrList=(/'inst_suffix'/), rc=rc) @@ -248,7 +343,7 @@ subroutine SetModelServices(ensemble_driver, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Set the driver log to the driver task 0 - if (mod(localPet, ntasks_per_member) == 0) then + if (petList(1) == localPet) then call NUOPC_CompAttributeGet(driver, name="diro", value=diro, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(driver, name="logfile", value=logfile, rc=rc) @@ -257,21 +352,76 @@ subroutine SetModelServices(ensemble_driver, rc) mastertask = .true. else logUnit = shrlogunit - mastertask = .false. endif call shr_file_setLogUnit (logunit) - - ! Create a clock for each driver instance - call esm_time_clockInit(ensemble_driver, driver, logunit, mastertask, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - endif + ! Create a clock for each driver instance + call esm_time_clockInit(ensemble_driver, driver, logunit, mastertask, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return enddo - deallocate(petList) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine SetModelServices + subroutine InitializeIO(ensemble_driver, rc) + use ESMF, only: ESMF_GridComp, ESMF_LOGMSG_INFO, ESMF_LogWrite + use ESMF, only: ESMF_SUCCESS, ESMF_VM, ESMF_GridCompGet, ESMF_VMGet + use ESMF, only: ESMF_CONFIG, ESMF_GridCompIsPetLocal, ESMF_State, ESMF_Clock + use NUOPC, only: NUOPC_CompAttributeGet, NUOPC_CompGet + use NUOPC_DRIVER, only: NUOPC_DriverGetComp + use driver_pio_mod , only: driver_pio_init, driver_pio_component_init + + type(ESMF_GridComp) :: ensemble_driver + type(ESMF_VM) :: ensemble_vm + integer, intent(out) :: rc + character(len=*), parameter :: subname = '('//__FILE__//':InitializeIO)' + type(ESMF_GridComp), pointer :: dcomp(:), ccomp(:) + integer :: iam + integer :: Global_Comm + integer :: drv, comp + character(len=8) :: compname + + rc = ESMF_SUCCESS + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + + call ESMF_GridCompGet(ensemble_driver, vm=ensemble_vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(ensemble_vm, localpet=iam, mpiCommunicator=Global_Comm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + nullify(dcomp) + call NUOPC_DriverGetComp(ensemble_driver, complist=dcomp, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do drv=1,size(dcomp) + if (ESMF_GridCompIsPetLocal(dcomp(drv), rc=rc) .or. asyncio_task) then + if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompGet(dcomp(drv), name=compname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//": call shr_pio_init "//compname, ESMF_LOGMSG_INFO) + call driver_pio_init(dcomp(drv), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//": call shr_pio_component_init "//compname, ESMF_LOGMSG_INFO) + call driver_pio_component_init(dcomp(drv), Global_Comm, asyncio_petlist, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//": shr_pio_component_init done "//compname, ESMF_LOGMSG_INFO) + endif + enddo + deallocate(asyncio_petlist) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + end subroutine InitializeIO + + subroutine ensemble_finalize(ensemble_driver, rc) + use ESMF, only : ESMF_GridComp, ESMF_SUCCESS + use shr_pio_mod, only: shr_pio_finalize + type(ESMF_GridComp) :: Ensemble_driver + integer, intent(out) :: rc + rc = ESMF_SUCCESS + call shr_pio_finalize() + + end subroutine ensemble_finalize end module Ensemble_driver diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index b6f39ad52..d4d89c217 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -55,7 +55,7 @@ subroutine SetServices(driver, rc) ! local variables type(ESMF_Config) :: runSeq - character(len=*), parameter :: subname = "(esm.F90:SetServices)" + character(len=*), parameter :: subname = '('//__FILE__//':SetServices)' !--------------------------------------- rc = ESMF_SUCCESS @@ -133,7 +133,7 @@ subroutine SetModelServices(driver, rc) integer :: maxthreads character(len=CL) :: msgstr integer :: componentcount - character(len=*), parameter :: subname = "(esm.F90:SetModelServices)" + character(len=*), parameter :: subname = '('//__FILE__//':SetModelServices)' !------------------------------------------- rc = ESMF_SUCCESS @@ -246,7 +246,7 @@ subroutine SetRunSequence(driver, rc) integer :: localrc type(ESMF_Config) :: runSeq type(NUOPC_FreeFormat) :: runSeqFF - character(len=*), parameter :: subname = "(esm.F90:SetRunSequence)" + character(len=*), parameter :: subname = '('//__FILE__//':SetRunSequence)' !--------------------------------------- rc = ESMF_SUCCESS @@ -344,7 +344,7 @@ recursive subroutine ModifyCplLists(driver, importState, exportState, clock, rc) character(len=CL), allocatable :: cplList(:) character(len=CL) :: tempString character(len=CL) :: msgstr - character(len=*), parameter :: subname = "(esm.F90:ModifyCplLists)" + character(len=*), parameter :: subname = '('//__FILE__//':pretty_print_nuopc_freeformat)' !--------------------------------------- rc = ESMF_SUCCESS @@ -443,7 +443,7 @@ subroutine InitAttributes(driver, rc) integer , parameter :: ens1=1 ! use first instance of ensemble only integer , parameter :: fix1=1 ! temporary hard-coding to first ensemble, needs to be fixed real(R8) , parameter :: epsilo = shr_const_mwwv/shr_const_mwdair - character(len=*) , parameter :: subname = '(InitAttributes)' + character(len=*), parameter :: subname = '('//__FILE__//':InitAttributes)' !---------------------------------------------------------- rc = ESMF_SUCCESS @@ -575,7 +575,7 @@ subroutine CheckAttributes( driver, rc ) character(len=CS) :: logFilePostFix ! postfix for output log files character(len=CL) :: outPathRoot ! root for output log files character(len=CS) :: cime_model - character(len=*), parameter :: subname = '(driver_attributes_check) ' + character(len=*), parameter :: subname = '('//__FILE__//':CheckAttributes)' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -635,7 +635,7 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, n character(len=CL) :: cvalue character(len=CS) :: attribute integer :: componentCount - character(len=*), parameter :: subname = "(esm.F90:AddAttributes)" + character(len=*), parameter :: subname = '('//__FILE__//':AddAttributes)' !------------------------------------------- rc = ESMF_Success @@ -737,7 +737,7 @@ subroutine ReadAttributes(gcomp, config, label, relaxedflag, formatprint, rc) ! local variables type(NUOPC_FreeFormat) :: attrFF - character(len=*), parameter :: subname = "(esm.F90:ReadAttributes)" + character(len=*), parameter :: subname = '('//__FILE__//':ReadAttributes)' !------------------------------------------- rc = ESMF_SUCCESS @@ -784,7 +784,7 @@ subroutine InitAdvertize(driver, importState, exportState, clock, rc) integer, intent(out) :: rc ! local variables - character(len=*), parameter :: subname = "(esm.F90:InitAdvertize)" + character(len=*), parameter :: subname = '('//__FILE__//':InitAdvertize)' !--------------------------------------- rc = ESMF_SUCCESS @@ -801,7 +801,8 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) use ESMF , only : ESMF_ConfigGetLen, ESMF_LogFoundAllocError, ESMF_ConfigGetAttribute use ESMF , only : ESMF_RC_NOT_VALID, ESMF_LogSetError, ESMF_Info, ESMF_InfoSet use ESMF , only : ESMF_GridCompIsPetLocal, ESMF_MethodAdd, ESMF_UtilStringLowerCase - use ESMF , only : ESMF_InfoCreate, ESMF_InfoDestroy + use ESMF , only : ESMF_InfoCreate, ESMF_InfoDestroy, ESMF_VMGetGlobal + use ESMF , only : ESMF_VMAllGather use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Driver , only : NUOPC_DriverAddComp #ifndef NO_MPI2 @@ -870,11 +871,14 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) ! local variables type(ESMF_GridComp) :: child type(ESMF_VM) :: vm + type(ESMF_VM) :: globalvm type(ESMF_Config) :: config type(ESMF_Info) :: info integer :: componentcount integer :: PetCount integer :: LocalPet + integer :: PetIDinGlobal(1) + integer, allocatable :: PetMapinGlobal(:) integer :: ntasks, rootpe, nthrds, stride integer :: ntask, cnt integer :: i @@ -884,7 +888,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) character(CL) :: msgstr integer, allocatable :: petlist(:) integer, pointer :: comms(:), comps(:) - integer :: Global_Comm + integer :: Driver_comm logical :: isPresent integer, allocatable :: comp_comm_iam(:) logical, allocatable :: comp_iamin(:) @@ -892,7 +896,8 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) character(CL) :: cvalue logical :: found_comp integer :: rank, nprocs, ierr - character(len=*), parameter :: subname = "(esm_pelayout.F90:esm_init_pelayout)" + integer :: n ! loop variable + character(len=*), parameter :: subname = '('//__FILE__//':esm_init_pelayout)' !--------------------------------------- rc = ESMF_SUCCESS @@ -901,10 +906,21 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) call ESMF_GridCompGet(driver, vm=vm, config=config, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGetGlobal(vm=globalvm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ReadAttributes(driver, config, "PELAYOUT_attributes::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, petCount=petCount, mpiCommunicator=Global_Comm, rc=rc) + call ESMF_VMGet(vm, petCount=petCount, LocalPet=LocalPet, mpiCommunicator=Driver_comm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(globalvm, LocalPet=PetIDinGlobal(1), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + allocate(PetMapinGlobal(petCount)) + call ESMF_VMAllGather(vm, PetIDinGlobal, PetMapinGlobal, 1, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return componentCount = ESMF_ConfigGetLen(config,label="component_list:", rc=rc) @@ -940,8 +956,8 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) allocate(comms(componentCount+1), comps(componentCount+1)) comps(1) = 1 comms = MPI_COMM_NULL - comms(1) = Global_Comm - + comms(1) = Driver_comm + ! First find the maximum number of threads across all components maxthreads = 1 do i=1,componentCount namestr = ESMF_UtilStringLowerCase(compLabels(i)) @@ -952,7 +968,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) if(nthrds > maxthreads) maxthreads = nthrds enddo - + ! Now loop over components and add each to driver do i=1,componentCount namestr = ESMF_UtilStringLowerCase(compLabels(i)) if (namestr == 'med') namestr = 'cpl' @@ -979,11 +995,22 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) call NUOPC_CompAttributeGet(driver, name=trim(namestr)//'_rootpe', value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) rootpe + + ! rootpe is specified in context of the ensemble_driver which may include asyncio tasks + ! so we need to adjust. + do n=1,PetCount + if(rootpe == PetMapinGlobal(n)) then + rootpe = n - 1 + exit + endif + enddo + if (rootpe < 0 .or. rootpe > PetCount) then write (msgstr, *) "Invalid Rootpe value specified for component: ",namestr, ' rootpe: ',rootpe call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) return endif + if(rootpe+ntasks > PetCount) then write (msgstr, *) "Invalid pelayout value specified for component: ",namestr, ' rootpe+ntasks: ',rootpe+ntasks call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) @@ -993,6 +1020,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) call NUOPC_CompAttributeGet(driver, name=trim(namestr)//'_pestride', value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) stride + if (stride < 1 .or. rootpe+(ntasks-1)*stride > PetCount) then write (msgstr, *) "Invalid pestride value specified for component: ",namestr,& ' rootpe: ',rootpe, ' pestride: ', stride, ' ntasks: ',ntasks, ' PetCount: ', PetCount @@ -1186,10 +1214,10 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Initialize MCT (this is needed for data models and cice prescribed capability) - call mct_world_init(componentCount+1, GLOBAL_COMM, comms, comps) + call mct_world_init(componentCount+1, DRIVER_COMM, comms, comps) - deallocate(petlist, comms, comps, comp_iamin, comp_comm_iam) + deallocate(petlist, comms, comps, comp_iamin, comp_comm_iam, PetMapinGlobal) end subroutine esm_init_pelayout @@ -1252,7 +1280,7 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) integer :: iscol_data(1) integer :: petcount character(len=CL) :: cvalue - character(len=*), parameter :: subname= ' (esm_get_single_column_attributes) ' + character(len=*), parameter :: subname = '('//__FILE__//':esm_set_single_column_attributes)' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS diff --git a/cesm/driver/esm_time_mod.F90 b/cesm/driver/esm_time_mod.F90 index 40c57b87c..46b95ed61 100644 --- a/cesm/driver/esm_time_mod.F90 +++ b/cesm/driver/esm_time_mod.F90 @@ -10,8 +10,8 @@ module esm_time_mod use ESMF , only : ESMF_Time, ESMF_TimeGet, ESMF_TimeSet use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalSet, ESMF_TimeIntervalGet use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_FAILURE, ESMF_LOGMSG_ERROR - use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast - use ESMF , only : ESMF_LOGMSG_INFO, ESMF_FAILURE + use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast, ESMF_VMAllReduce + use ESMF , only : ESMF_LOGMSG_INFO, ESMF_FAILURE, ESMF_GridCompIsPetLocal, ESMF_REDUCE_MAX use ESMF , only : operator(<), operator(/=), operator(+) use ESMF , only : operator(-), operator(*) , operator(>=) use ESMF , only : operator(<=), operator(>), operator(==) @@ -53,7 +53,7 @@ module esm_time_mod !=============================================================================== subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastertask, rc) - + ! input/output variables type(ESMF_GridComp) :: ensemble_driver, instance_driver integer, intent(in) :: logunit @@ -62,7 +62,8 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert ! local variables type(ESMF_Clock) :: clock - type(ESMF_VM) :: vm + type(ESMF_VM) :: vm ! VM of the driver + type(ESMF_VM) :: envm ! VM of the ensemble_driver (which includes asyncIO tasks) type(ESMF_Time) :: StartTime ! Start time type(ESMF_Time) :: RefTime ! Reference time type(ESMF_Time) :: CurrTime ! Current time @@ -101,100 +102,169 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert character(CL) :: tmpstr ! temporary character(CS) :: inst_suffix integer :: tmp(4) ! Array for Broadcast + integer :: myid, bcastID(2) logical :: isPresent - character(len=*), parameter :: subname = '(esm_time_clockInit): ' + logical :: firsttime = .true. + logical :: is_driver_pet + character(len=*), parameter :: subname = '('//__FILE__//':esm_time_clockInit) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - - call ESMF_GridCompGet(instance_driver, vm=vm, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) !--------------------------------------------------------------------------- ! Determine start time, reference time and current time !--------------------------------------------------------------------------- - call NUOPC_CompAttributeGet(instance_driver, name="start_ymd", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(ensemble_driver, name="start_ymd", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) start_ymd - call NUOPC_CompAttributeGet(instance_driver, name="start_tod", value=cvalue, rc=rc) + + call NUOPC_CompAttributeGet(ensemble_driver, name="start_tod", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) start_tod - call NUOPC_CompAttributeGet(instance_driver, name='read_restart', value=cvalue, rc=rc) + !--------------------------------------------------------------------------- + ! Determine driver clock timestep + !--------------------------------------------------------------------------- + + call NUOPC_CompAttributeGet(ensemble_driver, name="atm_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) atm_cpl_dt + + call NUOPC_CompAttributeGet(ensemble_driver, name="lnd_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) lnd_cpl_dt + + call NUOPC_CompAttributeGet(ensemble_driver, name="ice_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) ice_cpl_dt + + call NUOPC_CompAttributeGet(ensemble_driver, name="ocn_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) ocn_cpl_dt + + call NUOPC_CompAttributeGet(ensemble_driver, name="glc_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) glc_cpl_dt + + call NUOPC_CompAttributeGet(ensemble_driver, name="rof_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) rof_cpl_dt + + call NUOPC_CompAttributeGet(ensemble_driver, name="wav_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) wav_cpl_dt + + call NUOPC_CompAttributeGet(ensemble_driver, name="glc_avg_period", value=glc_avg_period, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) read_restart + read(cvalue,*) glc_avg_period + + dtime_drv = minval((/atm_cpl_dt, lnd_cpl_dt, ocn_cpl_dt, ice_cpl_dt, glc_cpl_dt, rof_cpl_dt, wav_cpl_dt/)) + if(mastertask) then + write(tmpstr,'(i10)') dtime_drv + call ESMF_LogWrite(trim(subname)//': driver time interval is : '// trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + write(logunit,*) trim(subname)//': driver time interval is : '// trim(tmpstr) + endif - if (read_restart) then + call ESMF_GridCompGet(ensemble_driver, vm=envm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(envm, localPet=myid, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + is_driver_pet = ESMF_GridCompIsPetLocal(instance_driver, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(instance_driver, name='drv_restart_pointer', value=restart_file, rc=rc) + if(is_driver_pet) then + call ESMF_GridCompGet(instance_driver, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (trim(restart_file) /= 'none') then + ! read_restart is set in ensemble_driver SetModelServices + call NUOPC_CompAttributeGet(ensemble_driver, name='read_restart', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) read_restart - call NUOPC_CompAttributeGet(instance_driver, name="inst_suffix", isPresent=isPresent, rc=rc) + if (read_restart) then + + call NUOPC_CompAttributeGet(instance_driver, name='drv_restart_pointer', value=restart_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if(isPresent) then - call NUOPC_CompAttributeGet(instance_driver, name="inst_suffix", value=inst_suffix, rc=rc) + + if (trim(restart_file) /= 'none') then + ! inst_suffix is set by ensemble_driver if the number of members is > 1 + call NUOPC_CompAttributeGet(instance_driver, name="inst_suffix", isPresent=isPresent, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - inst_suffix = "" - endif - - restart_pfile = trim(restart_file)//inst_suffix - - if (mastertask) then - call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), & - ESMF_LOGMSG_INFO) - open(newunit=unitn, file=restart_pfile, form='FORMATTED', status='old',iostat=ierr) - if (ierr < 0) then - rc = ESMF_FAILURE - call ESMF_LogWrite(trim(subname)//' ERROR rpointer file open returns error', & - ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__) - return - end if - read(unitn,'(a)', iostat=ierr) restart_file - if (ierr < 0) then - rc = ESMF_FAILURE - call ESMF_LogWrite(trim(subname)//' ERROR rpointer file read returns error', & - ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__) - return - end if - close(unitn) + if(isPresent) then + call NUOPC_CompAttributeGet(instance_driver, name="inst_suffix", value=inst_suffix, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + inst_suffix = "" + endif + + restart_pfile = trim(restart_file)//inst_suffix + if (mastertask) then - write(logunit,'(a)') trim(subname)//" reading driver restart from file = "//trim(restart_file) - end if - call esm_time_read_restart(restart_file, start_ymd, start_tod, curr_ymd, curr_tod, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), & + ESMF_LOGMSG_INFO) + open(newunit=unitn, file=restart_pfile, form='FORMATTED', status='old',iostat=ierr) + if (ierr < 0) then + rc = ESMF_FAILURE + call ESMF_LogWrite(trim(subname)//' ERROR rpointer file open returns error', & + ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__) + return + end if + read(unitn,'(a)', iostat=ierr) restart_file + if (ierr < 0) then + rc = ESMF_FAILURE + call ESMF_LogWrite(trim(subname)//' ERROR rpointer file read returns error', & + ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__) + return + end if + close(unitn) + if (mastertask) then + write(logunit,'(a)') trim(subname)//" reading driver restart from file = "//trim(restart_file) + end if + call esm_time_read_restart(restart_file, start_ymd, start_tod, curr_ymd, curr_tod, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + endif - tmp(1) = start_ymd ; tmp(2) = start_tod - tmp(3) = curr_ymd ; tmp(4) = curr_tod - endif + else - call ESMF_VMBroadcast(vm, tmp, 4, 0, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - start_ymd = tmp(1) ; start_tod = tmp(2) - curr_ymd = tmp(3) ; curr_tod = tmp(4) + if (mastertask) then + write(logunit,*) ' NOTE: the current compset has no mediator - which provides the clock restart information' + write(logunit,*) ' In this case the restarts are handled solely by the component being used and' + write(logunit,*) ' and the driver clock will always be starting from the initial date on restart' + end if + curr_ymd = start_ymd + curr_tod = start_tod + + end if else - if (mastertask) then - write(logunit,*) ' NOTE: the current compset has no mediator - which provides the clock restart information' - write(logunit,*) ' In this case the restarts are handled solely by the component being used and' - write(logunit,*) ' and the driver clock will always be starting from the initial date on restart' - end if curr_ymd = start_ymd curr_tod = start_tod - end if - - else + end if ! end if read_restart + endif - curr_ymd = start_ymd - curr_tod = start_tod - end if ! end if read_restart + if(mastertask) then + bcastID(1) = myid + tmp(1) = start_ymd ; tmp(2) = start_tod + tmp(3) = curr_ymd ; tmp(4) = curr_tod + else + bcastID(1) = 0 + tmp = 0 + endif + call ESMF_VMAllReduce(envm, bcastID(1:1), bcastID(2:2), 1, ESMF_REDUCE_MAX,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMBroadcast(envm, tmp, 4, bcastID(2), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + start_ymd = tmp(1) ; start_tod = tmp(2) + curr_ymd = tmp(3) ; curr_tod = tmp(4) + ! Determine start time (THE FOLLOWING ASSUMES THAT THE DEFAULT CALENDAR IS SET in the driver) call esm_time_date2ymd(start_ymd, yr, mon, day) @@ -231,48 +301,6 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert call ESMF_TimeSet( RefTime, yy=yr, mm=mon, dd=day, s=ref_tod, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !--------------------------------------------------------------------------- - ! Determine driver clock timestep - !--------------------------------------------------------------------------- - - call NUOPC_CompAttributeGet(instance_driver, name="atm_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) atm_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="lnd_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) lnd_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="ice_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) ice_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="ocn_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) ocn_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="glc_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) glc_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="rof_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) rof_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="wav_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) wav_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="glc_avg_period", value=glc_avg_period, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) glc_avg_period - - dtime_drv = minval((/atm_cpl_dt, lnd_cpl_dt, ocn_cpl_dt, ice_cpl_dt, glc_cpl_dt, rof_cpl_dt, wav_cpl_dt/)) - if(mastertask) then - write(tmpstr,'(i10)') dtime_drv - call ESMF_LogWrite(trim(subname)//': driver time interval is : '// trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - write(logunit,*) trim(subname)//': driver time interval is : '// trim(tmpstr) - endif call ESMF_TimeIntervalSet( TimeStep, s=dtime_drv, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -294,20 +322,22 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert if (ChkErr(rc,__LINE__,u_FILE_u)) return end do - ! Set the ensemble driver gridded component clock to the created clock - call ESMF_GridCompSet(instance_driver, clock=clock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Set the driver gridded component clock to the created clock + if (is_driver_pet) then + call ESMF_GridCompSet(instance_driver, clock=clock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif ! Set driver clock stop time - call NUOPC_CompAttributeGet(instance_driver, name="stop_option", value=stop_option, rc=rc) + call NUOPC_CompAttributeGet(ensemble_driver, name="stop_option", value=stop_option, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(instance_driver, name="stop_n", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(ensemble_driver, name="stop_n", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) stop_n - call NUOPC_CompAttributeGet(instance_driver, name="stop_ymd", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(ensemble_driver, name="stop_ymd", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) stop_ymd - call NUOPC_CompAttributeGet(instance_driver, name="stop_tod", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(ensemble_driver, name="stop_tod", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) stop_tod if ( stop_ymd < 0) then @@ -315,6 +345,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert stop_tod = 0 endif + if (mastertask) then write(tmpstr,'(i10)') stop_ymd call ESMF_LogWrite(trim(subname)//': driver stop_ymd: '// trim(tmpstr), ESMF_LOGMSG_INFO) @@ -342,17 +373,20 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert !--------------------------------------------------------------------------- ! Create the ensemble driver clock - ! TODO: this is done repeatedly - but only needs to be done the first time this is called !--------------------------------------------------------------------------- + if(firsttime) then + ! TimeStep for the ensemble_driver and any asyncIO tasks is the full length of + ! the model run. + TimeStep = StopTime - ClockTime + clock = ESMF_ClockCreate(TimeStep, ClockTime, StopTime=StopTime, & + refTime=RefTime, name='ESMF ensemble Driver Clock', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - TimeStep = StopTime - ClockTime - clock = ESMF_ClockCreate(TimeStep, ClockTime, StopTime=StopTime, & - refTime=RefTime, name='ESMF ensemble Driver Clock', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_GridCompSet(ensemble_driver, clock=clock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - + call ESMF_GridCompSet(ensemble_driver, clock=clock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + firsttime = .false. + endif + end subroutine esm_time_clockInit !=============================================================================== diff --git a/cesm/nuopc_cap_share/driver_pio_mod.F90 b/cesm/nuopc_cap_share/driver_pio_mod.F90 index 0e743d669..5b9edd426 100644 --- a/cesm/nuopc_cap_share/driver_pio_mod.F90 +++ b/cesm/nuopc_cap_share/driver_pio_mod.F90 @@ -169,51 +169,112 @@ subroutine driver_pio_init(driver, rc) end subroutine driver_pio_init - subroutine driver_pio_component_init(driver, ncomps, rc) + subroutine driver_pio_component_init(driver, Global_comm, asyncio_petlist, rc) use ESMF, only : ESMF_GridComp, ESMF_LogSetError, ESMF_RC_NOT_VALID, ESMF_GridCompIsCreated, ESMF_VM, ESMF_VMGet - use ESMF, only : ESMF_GridCompGet, ESMF_GridCompIsPetLocal, ESMF_VMIsCreated + use ESMF, only : ESMF_GridCompGet, ESMF_GridCompIsPetLocal, ESMF_VMIsCreated, ESMF_Finalize, ESMF_PtrInt1D + use ESMF, only : ESMF_LOGMSG_INFO, ESMF_LOGWRITE use NUOPC, only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd use NUOPC_Driver, only : NUOPC_DriverGetComp + use mpi, only : MPI_INTEGER, MPI_MAX, MPI_IN_PLACE, MPI_LOR, MPI_LOGICAL type(ESMF_GridComp) :: driver - type(ESMF_VM) :: vm - integer, intent(in) :: ncomps + integer, intent(in) :: Global_COMM ! The communicator associated with the ensemble_driver + integer, intent(in) :: asyncio_petlist(:) integer, intent(out) :: rc + type(ESMF_VM) :: vm integer :: i, npets, default_stride - integer :: j + integer :: j, myid + integer :: k integer :: comp_comm, comp_rank + integer, allocatable :: procs_per_comp(:), async_procs_per_comp(:) + integer, allocatable :: io_proc_list(:), asyncio_tasks(:), comp_proc_list(:,:) + type(ESMF_GridComp), pointer :: gcomp(:) character(CS) :: cval character(CS) :: msgstr integer :: do_async_init + integer :: totalpes + integer :: asyncio_ntasks + integer :: asyncio_stride + integer :: pecnt + integer :: ierr + integer :: iocomm + integer :: ncomps + integer :: async_rearr + integer :: driverpecount, driver_myid + integer, allocatable :: driverpetlist(:) + integer, allocatable :: asyncio_comp_comm(:) + logical :: asyncio_task + logical, allocatable :: petlocal(:) type(iosystem_desc_t), allocatable :: async_iosystems(:) + character(len=*), parameter :: subname = '('//__FILE__//':shr_pio_component_init)' - allocate(pio_comp_settings(ncomps)) - allocate(gcomp(ncomps)) - - allocate(io_compid(ncomps)) - allocate(io_compname(ncomps)) - allocate(iosystems(ncomps)) + asyncio_ntasks = size(asyncio_petlist) - allocate(pio_async_interface(ncomps)) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call MPI_Comm_rank(global_comm, myid, rc) + call MPI_Comm_size(global_comm, totalpes, rc) + asyncio_task=.false. + do i=1,asyncio_ntasks + if(myid == asyncio_petlist(i)) then + asyncio_task = .true. + exit + endif + enddo nullify(gcomp) - do_async_init = 0 - call NUOPC_DriverGetComp(driver, compList=gcomp, rc=rc) + if (asyncio_task) then + driverpecount = 0 + else + call ESMF_GridCompGet(gridcomp=driver, vm=vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_DriverGetComp(driver, compList=gcomp, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(vm, localPet=driver_myid, petcount=driverpecount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + endif + + if(associated(gcomp)) then + total_comps = size(gcomp) + else + total_comps = 0 + endif + + call ESMF_LogWrite(trim(subname)//": share total_comps and driverpecount", ESMF_LOGMSG_INFO) if (chkerr(rc,__LINE__,u_FILE_u)) return - total_comps = size(gcomp) + call MPI_AllReduce(MPI_IN_PLACE, total_comps, 1, MPI_INTEGER, & + MPI_MAX, Global_comm, rc) + call MPI_AllReduce(MPI_IN_PLACE, driverpecount, 1, MPI_INTEGER, & + MPI_MAX, Global_comm, rc) + allocate(pio_comp_settings(total_comps)) + allocate(procs_per_comp(total_comps)) + allocate(io_compid(total_comps)) + allocate(io_compname(total_comps)) + allocate(iosystems(total_comps)) + allocate(petlocal(total_comps)) + do_async_init = 0 + procs_per_comp = 0 + do i=1,total_comps + if(associated(gcomp)) then + petlocal(i) = ESMF_GridCompIsPetLocal(gcomp(i), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + petlocal(i) = .false. + endif + pio_comp_settings(i)%pio_async_interface = .false. io_compid(i) = i+1 - - if (ESMF_GridCompIsPetLocal(gcomp(i), rc=rc)) then + if (petlocal(i)) then call ESMF_GridCompGet(gcomp(i), vm=vm, name=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//": initialize component: "//trim(cval), ESMF_LOGMSG_INFO) io_compname(i) = trim(cval) - call NUOPC_CompAttributeAdd(gcomp(i), attrList=(/'MCTID'/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -225,35 +286,41 @@ subroutine driver_pio_component_init(driver, ncomps, rc) ssiLocalPetCount=default_stride, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp(i), name="pio_stride", value=cval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cval, *) pio_comp_settings(i)%pio_stride - if(pio_comp_settings(i)%pio_stride <= 0 .or. pio_comp_settings(i)%pio_stride > npets) then - pio_comp_settings(i)%pio_stride = min(npets, default_stride) - endif - - call NUOPC_CompAttributeGet(gcomp(i), name="pio_rearranger", value=cval, rc=rc) + procs_per_comp(i) = npets + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_async_interface", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cval, *) pio_comp_settings(i)%pio_rearranger + pio_comp_settings(i)%pio_async_interface = (trim(cval) == '.true.') + if(.not. pio_comp_settings(i)%pio_async_interface) then + call NUOPC_CompAttributeGet(gcomp(i), name="pio_stride", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cval, *) pio_comp_settings(i)%pio_stride + if(pio_comp_settings(i)%pio_stride <= 0 .or. pio_comp_settings(i)%pio_stride > npets) then + pio_comp_settings(i)%pio_stride = min(npets, default_stride) + endif - call NUOPC_CompAttributeGet(gcomp(i), name="pio_numiotasks", value=cval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cval, *) pio_comp_settings(i)%pio_numiotasks + call NUOPC_CompAttributeGet(gcomp(i), name="pio_rearranger", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cval, *) pio_comp_settings(i)%pio_rearranger + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_numiotasks", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cval, *) pio_comp_settings(i)%pio_numiotasks - if(pio_comp_settings(i)%pio_numiotasks < 0 .or. pio_comp_settings(i)%pio_numiotasks > npets) then - pio_comp_settings(i)%pio_numiotasks = max(1,npets/pio_comp_settings(i)%pio_stride) - endif + if(pio_comp_settings(i)%pio_numiotasks < 0 .or. pio_comp_settings(i)%pio_numiotasks > npets) then + pio_comp_settings(i)%pio_numiotasks = max(1,npets/pio_comp_settings(i)%pio_stride) + endif - call NUOPC_CompAttributeGet(gcomp(i), name="pio_root", value=cval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cval, *) pio_comp_settings(i)%pio_root + call NUOPC_CompAttributeGet(gcomp(i), name="pio_root", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cval, *) pio_comp_settings(i)%pio_root - if(pio_comp_settings(i)%pio_root < 0 .or. pio_comp_settings(i)%pio_root > npets) then - pio_comp_settings(i)%pio_root = 0 + if(pio_comp_settings(i)%pio_root < 0 .or. pio_comp_settings(i)%pio_root > npets) then + pio_comp_settings(i)%pio_root = 0 + endif endif - call NUOPC_CompAttributeGet(gcomp(i), name="pio_typename", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -280,9 +347,7 @@ subroutine driver_pio_component_init(driver, ncomps, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call driver_pio_getioformatfromname(cval, pio_comp_settings(i)%pio_netcdf_ioformat, PIO_64BIT_DATA) - if (pio_async_interface(i)) then - do_async_init = do_async_init + 1 - else + if (.not. pio_comp_settings(i)%pio_async_interface) then if(pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req < PIO_REARR_COMM_UNLIMITED_PEND_REQ) then pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req = pio_comp_settings(i)%pio_numiotasks endif @@ -293,39 +358,125 @@ subroutine driver_pio_component_init(driver, ncomps, rc) pio_comp_settings(i)%pio_rearranger, iosystems(i), pio_comp_settings(i)%pio_root, & pio_rearr_opts) endif + ! Write the PIO settings to the beggining of each component log + if(comp_rank == 0) call shr_pio_log_comp_settings(gcomp(i), rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + endif enddo + + call ESMF_LogWrite(trim(subname)//": check for async", ESMF_LOGMSG_INFO) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do i=1,total_comps + call MPI_AllReduce(MPI_IN_PLACE, pio_comp_settings(i)%pio_async_interface, 1, MPI_LOGICAL, & + MPI_LOR, global_comm, rc) + if(pio_comp_settings(i)%pio_async_interface) then + do_async_init = do_async_init + 1 + endif + enddo + +! +! Get the PET list for each component using async IO +! + + call MPI_Allreduce(MPI_IN_PLACE, do_async_init, 1, MPI_INTEGER, MPI_MAX, Global_comm, ierr) + call MPI_Allreduce(MPI_IN_PLACE, procs_per_comp, total_comps, MPI_INTEGER, MPI_MAX, Global_comm, ierr) + if (do_async_init > 0) then + allocate(asyncio_comp_comm(do_async_init)) + allocate(comp_proc_list(driverpecount, do_async_init)) + j = 1 + k = 1 + comp_proc_list = -1 + if(.not. asyncio_task) then + do i=1,total_comps + if(pio_comp_settings(i)%pio_async_interface) then + if(petlocal(i)) comp_proc_list(1+driver_myid,j) = myid + do k=1,size(asyncio_petlist) + if(comp_proc_list(1+driver_myid, j) == asyncio_petlist(k)) then + call shr_sys_abort(subname//' ERROR: OVERLAP with asyncio_petlist') + endif + enddo + j = j+1 + endif + enddo + endif + call MPI_AllReduce(MPI_IN_PLACE, comp_proc_list, driverpecount*do_async_init, MPI_INTEGER, MPI_MAX, Global_comm, ierr) + if(asyncio_ntasks == 0) then + call shr_sys_abort(subname//' ERROR: ASYNC IO Requested but no IO PES assigned') + endif + + do i=1,do_async_init + do j=1,driverpecount + if(comp_proc_list(j,i) == -1) then + do k=j+1,driverpecount + if(comp_proc_list(k,i) >= 0) then + comp_proc_list(j,i) = comp_proc_list(k,i) + comp_proc_list(k,i) = -1 + exit + endif + enddo + endif + enddo + enddo + allocate(async_iosystems(do_async_init)) + allocate(async_procs_per_comp(do_async_init)) j=1 do i=1,total_comps - if(pio_async_interface(i)) then - iosystems(i) = async_iosystems(j) + if(pio_comp_settings(i)%pio_async_interface) then + async_procs_per_comp(j) = procs_per_comp(i) j = j+1 + if(async_rearr == 0) then + async_rearr = pio_comp_settings(i)%pio_rearranger + elseif(async_rearr .ne. pio_comp_settings(i)%pio_rearranger) then + call shr_sys_abort(subname//' ERROR: all async component rearrangers must match') + endif endif enddo - + ! IO tasks should not return until the run is completed +! ierr = pio_set_log_level(3) + + call ESMF_LogWrite(trim(subname)//": call async pio_init", ESMF_LOGMSG_INFO) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call pio_init(async_iosystems, Global_comm, async_procs_per_comp, comp_proc_list, asyncio_petlist, & + async_rearr, asyncio_comp_comm, io_comm) + if(.not. asyncio_task) then + j=1 + do i=1,total_comps + if(pio_comp_settings(i)%pio_async_interface) then + iosystems(i) = async_iosystems(j) + j = j+1 + endif + enddo + endif endif + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) deallocate(gcomp) end subroutine driver_pio_component_init - subroutine driver_pio_log_comp_settings(gcomp, logunit) - use ESMF, only : ESMF_GridComp, ESMF_GridCompGet + subroutine driver_pio_log_comp_settings(gcomp, logunit, rc) + use ESMF, only : ESMF_GridComp, ESMF_GridCompGet, ESMF_SUCCESS use NUOPC, only: NUOPC_CompAttributeGet type(ESMF_GridComp) :: gcomp - integer, intent(in) :: logunit + integer, intent(out) :: rc + integer :: logunit integer :: compid character(len=CS) :: name, cval integer :: i - integer :: rc logical :: isPresent + rc = ESMF_SUCCESS call ESMF_GridCompGet(gcomp, name=name, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name='logunit', value=logunit, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name="MCTID", value=cval, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -333,13 +484,15 @@ subroutine driver_pio_log_comp_settings(gcomp, logunit) read(cval, *) compid i = shr_pio_getindex(compid) endif - write(logunit,*) trim(name),': PIO numiotasks=', pio_comp_settings(i)%pio_numiotasks - - write(logunit, *) trim(name), ': PIO stride=',pio_comp_settings(i)%pio_stride - - write(logunit, *) trim(name),': PIO rearranger=',pio_comp_settings(i)%pio_rearranger - write(logunit, *) trim(name),': PIO root=',pio_comp_settings(i)%pio_root + if(pio_comp_settings(i)%pio_async_interface) then + write(logunit,*) trim(name),': using ASYNC IO interface' + else + write(logunit,*) trim(name),': PIO numiotasks=', pio_comp_settings(i)%pio_numiotasks + write(logunit, *) trim(name), ': PIO stride=',pio_comp_settings(i)%pio_stride + write(logunit, *) trim(name),': PIO rearranger=',pio_comp_settings(i)%pio_rearranger + write(logunit, *) trim(name),': PIO root=',pio_comp_settings(i)%pio_root + endif end subroutine driver_pio_log_comp_settings @@ -347,7 +500,8 @@ end subroutine driver_pio_log_comp_settings subroutine driver_pio_finalize( ) integer :: ierr integer :: i - do i=1,total_comps + + do i=1,size(iosystems) call pio_finalize(iosystems(i), ierr) end do diff --git a/cesm/nuopc_cap_share/glc_elevclass_mod.F90 b/cesm/nuopc_cap_share/glc_elevclass_mod.F90 index 3a984f642..ee32d7c77 100644 --- a/cesm/nuopc_cap_share/glc_elevclass_mod.F90 +++ b/cesm/nuopc_cap_share/glc_elevclass_mod.F90 @@ -78,7 +78,7 @@ subroutine glc_elevclass_init_default(my_glc_nec, logunit) integer, intent(in), optional :: logunit ! ! !LOCAL VARIABLES: - character(len=*), parameter :: subname = 'glc_elevclass_init' + character(len=*), parameter :: subname = '('//__FILE__//':glc_elevclass_init_default)' !----------------------------------------------------------------------- glc_nec = my_glc_nec @@ -130,7 +130,7 @@ subroutine glc_elevclass_init_override(my_glc_nec, my_topomax) ! ! !LOCAL VARIABLES: - character(len=*), parameter :: subname = 'glc_elevclass_init_override' + character(len=*), parameter :: subname = '('//__FILE__//':glc_elevclass_init_override)' !----------------------------------------------------------------------- SHR_ASSERT_ALL_FL((ubound(my_topomax) == (/my_glc_nec/)), __FILE__, __LINE__) @@ -147,7 +147,7 @@ subroutine glc_elevclass_clean() ! !DESCRIPTION: ! Deallocate memory allocated in this module - character(len=*), parameter :: subname = 'glc_elevclass_clean' + character(len=*), parameter :: subname = '('//__FILE__//':glc_elevclass_clean)' !----------------------------------------------------------------------- if (allocated(topomax)) then @@ -169,7 +169,7 @@ function glc_get_num_elevation_classes() result(num_elevation_classes) ! ! !LOCAL VARIABLES: - character(len=*), parameter :: subname = 'glc_get_num_elevation_classes' + character(len=*), parameter :: subname = '('//__FILE__//':glc_elevclass_clean)' !----------------------------------------------------------------------- num_elevation_classes = glc_nec @@ -199,7 +199,7 @@ subroutine glc_get_elevation_classes_without_bareland(glc_topo, glc_elevclass, l integer :: glc_pt integer :: err_code - character(len=*), parameter :: subname = 'get_glc_elevation_classes' + character(len=*), parameter :: subname = '('//__FILE__//':glc_get_elevation_classes_without_bareland)' !----------------------------------------------------------------------- npts = size(glc_elevclass) @@ -246,7 +246,7 @@ subroutine glc_get_elevation_classes_with_bareland(glc_ice_covered, glc_topo, gl ! Tolerance for checking whether ice_covered is 0 or 1 real(r8), parameter :: ice_covered_tol = 1.e-13 - character(len=*), parameter :: subname = 'get_glc_elevation_classes' + character(len=*), parameter :: subname = '('//__FILE__//':glc_get_elevation_classes_with_bareland)' !----------------------------------------------------------------------- npts = size(glc_elevclass) @@ -315,7 +315,7 @@ subroutine glc_get_elevation_class(topo, elevation_class, err_code) ! !LOCAL VARIABLES: integer :: ec ! temporary elevation class - character(len=*), parameter :: subname = 'glc_get_elevation_class' + character(len=*), parameter :: subname = '('//__FILE__//':glc_get_elevation_class)' !----------------------------------------------------------------------- if (glc_nec < 1) then @@ -359,7 +359,7 @@ function glc_get_elevclass_bounds() result(elevclass_bounds) ! ! !LOCAL VARIABLES: - character(len=*), parameter :: subname = 'glc_get_elevclass_bounds' + character(len=*), parameter :: subname = '('//__FILE__//':glc_get_elevation_class)' !----------------------------------------------------------------------- elevclass_bounds(:) = topomax(:) @@ -388,7 +388,7 @@ function glc_elevclass_as_string(elevation_class) result(ec_string) ! !LOCAL VARIABLES: character(len=16) :: format_string - character(len=*), parameter :: subname = 'glc_elevclass_as_string' + character(len=*), parameter :: subname = '('//__FILE__//':glc_get_elevation_class)' !----------------------------------------------------------------------- ! e.g., for GLC_ELEVCLASS_STRLEN = 2, format_string will be '(i2.2)' @@ -412,7 +412,7 @@ function glc_mean_elevation_virtual(elevation_class, logunit) result(mean_elevat integer :: resulting_elevation_class integer :: err_code - character(len=*), parameter :: subname = 'glc_mean_elevation_virtual' + character(len=*), parameter :: subname = '('//__FILE__//':glc_get_elevation_class)' !----------------------------------------------------------------------- if (elevation_class == 0) then @@ -478,7 +478,7 @@ function glc_errcode_to_string(err_code) result(err_string) ! ! !LOCAL VARIABLES: - character(len=*), parameter :: subname = 'glc_errcode_to_string' + character(len=*), parameter :: subname = '('//__FILE__//':glc_get_elevation_class)' !----------------------------------------------------------------------- select case (err_code) @@ -522,7 +522,7 @@ subroutine glc_get_fractional_icecov(nec, glc_topo, glc_icefrac, glc_icefrac_ec, integer :: ec integer :: glc_pt integer :: err_code - character(len=*), parameter :: subname = 'get_glc_elevation_classes' + character(len=*), parameter :: subname = '('//__FILE__//':glc_get_fractional_icecov)' !----------------------------------------------------------------------- npts = size(glc_topo) diff --git a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 index 8d472902b..c001bd3b7 100644 --- a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 +++ b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 @@ -22,7 +22,6 @@ module nuopc_shr_methods use NUOPC_Model , only : NUOPC_ModelGet use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs use shr_sys_mod , only : shr_sys_abort - use shr_file_mod , only : shr_file_setlogunit, shr_file_getLogUnit implicit none private @@ -132,7 +131,10 @@ end subroutine get_component_instance !=============================================================================== subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) + use NUOPC, only : NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd + use ESMF, only : ESMF_GridCompGet, ESMF_LOGMSG_INFO, ESMF_LogWrite use driver_pio_mod, only : driver_pio_log_comp_settings + ! input/output variables type(ESMF_GridComp) :: gcomp logical, intent(in) :: mastertask @@ -144,7 +146,9 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) character(len=CL) :: diro character(len=CL) :: logfile character(len=CL) :: inst_suffix + character(len=CL) :: name integer :: inst_index ! not used here + character(len=*), parameter :: subname = "("//__FILE__//": set_component_logging)" !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -164,15 +168,25 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) endif open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) - ! Write the PIO settings to the beggining of each component log - call driver_pio_log_comp_settings(gcomp, logunit) + ! Write the PIO settings to the beggining of each component log + call driver_pio_log_comp_settings(gcomp, logunit, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return else logUnit = 6 endif - ! TODO: shr_file mod is deprecated and should be removed. - call shr_file_setLogUnit (logunit) + + call ESMF_GridCompGet(gcomp, name=name, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//": setting logunit for component: "//trim(name), ESMF_LOGMSG_INFO) + + call NUOPC_CompAttributeAdd(gcomp, attrList=(/'logunit'/), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeSet(gcomp, name='logunit',value=logunit, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end subroutine set_component_logging !=============================================================================== @@ -225,7 +239,7 @@ subroutine state_getscalar(state, scalar_id, scalar_value, flds_scalar_name, fld type(ESMF_Field) :: field real(r8), pointer :: farrayptr(:,:) real(r8) :: tmp(1) - character(len=*), parameter :: subname='(state_getscalar)' + character(len=*), parameter :: subname = '('//__FILE__//':state_getscalar)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -276,7 +290,7 @@ subroutine state_setscalar(scalar_value, scalar_id, State, flds_scalar_name, fld type(ESMF_Field) :: lfield type(ESMF_VM) :: vm real(r8), pointer :: farrayptr(:,:) - character(len=*), parameter :: subname='(state_setscalar)' + character(len=*), parameter :: subname = '('//__FILE__//':state_setscalar)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -322,7 +336,7 @@ subroutine state_diagnose(State, string, rc) character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) real(r8), pointer :: dataPtr1d(:) real(r8), pointer :: dataPtr2d(:,:) - character(len=*),parameter :: subname='(state_diagnose)' + character(len=*), parameter :: subname = '('//__FILE__//':state_diagnose)' ! ---------------------------------------------- call ESMF_StateGet(state, itemCount=fieldCount, rc=rc) @@ -399,7 +413,7 @@ subroutine field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc) type(ESMF_Mesh) :: lmesh integer :: lrank, nnodes, nelements logical :: labort - character(len=*), parameter :: subname='(field_getfldptr)' + character(len=*), parameter :: subname = '('//__FILE__//':field_getfldptr)' ! ---------------------------------------------- if (.not.present(rc)) then @@ -526,7 +540,7 @@ subroutine alarmInit( clock, alarm, option, & type(ESMF_Time) :: NextAlarm ! Next restart alarm time type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval integer :: sec - character(len=*), parameter :: subname = '(set_alarmInit): ' + character(len=*), parameter :: subname = '('//__FILE__//':alarmInit)' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -810,7 +824,7 @@ subroutine timeInit( Time, ymd, cal, tod, rc) ! local variables integer :: year, mon, day ! year, month, day as integers integer :: tdate ! temporary date - character(len=*), parameter :: subname='(timeInit)' + character(len=*), parameter :: subname = '('//__FILE__//':timeInit)' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS diff --git a/cesm/nuopc_cap_share/seq_drydep_mod.F90 b/cesm/nuopc_cap_share/seq_drydep_mod.F90 index 780a6c611..0d98f5c85 100644 --- a/cesm/nuopc_cap_share/seq_drydep_mod.F90 +++ b/cesm/nuopc_cap_share/seq_drydep_mod.F90 @@ -1,26 +1,1221 @@ module seq_drydep_mod - use shr_drydep_mod, only: seq_drydep_setHCoeff=>shr_drydep_setHCoeff - use shr_drydep_mod + !======================================================================== + ! Module for handling dry depostion of tracers. + ! This module is shared by land and atmosphere models for the computations of + ! dry deposition of tracers + !======================================================================== + + use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMGet + use ESMF , only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_SUCCESS + use shr_sys_mod , only : shr_sys_abort + use shr_kind_mod , only : r8 => shr_kind_r8, CS => SHR_KIND_CS, CX => SHR_KIND_CX + use shr_const_mod , only : SHR_CONST_G, SHR_CONST_RDAIR, SHR_CONST_CPDAIR, SHR_CONST_MWWV + use shr_mpi_mod , only : shr_mpi_bcast + use shr_nl_mod , only : shr_nl_find_group_name + use shr_log_mod , only : s_logunit => shr_log_Unit + use shr_infnan_mod , only : shr_infnan_posinf, assignment(=) implicit none + private + + ! public member functions + public :: seq_drydep_readnl ! Read namelist + public :: seq_drydep_init ! Initialization of drydep data + public :: seq_drydep_setHCoeff ! Calculate Henry's law coefficients + + ! private array sizes + integer, public, parameter :: n_species_table = 192 ! Number of species to work with + integer, private, parameter :: maxspc = 210 ! Maximum number of species + integer, private, parameter :: NSeas = 5 ! Number of seasons + integer, private, parameter :: NLUse = 11 ! Number of land-use types + logical, private :: drydep_initialized = .false. + + ! public data members: ! method specification - character(len=*), parameter :: DD_XLND = 'xactive_lnd' ! dry-dep land - character(len=*), parameter :: drydep_method = DD_XLND ! XLND is the only option now - logical, protected :: lnd_drydep + character(16),public,parameter :: DD_XATM = 'xactive_atm' ! dry-dep atmosphere + character(16),public,parameter :: DD_XLND = 'xactive_lnd' ! dry-dep land + character(16),public,parameter :: DD_TABL = 'table' ! dry-dep table (atm and lnd) + character(16),public :: drydep_method = DD_XLND ! Which option choosen + + real(r8), public, parameter :: ph = 1.e-5_r8 ! measure of the acidity (dimensionless) + + logical, public :: lnd_drydep ! If dry-dep fields passed + integer, public :: n_drydep = 0 ! Number in drypdep list + logical :: drydep_init = .false. ! has seq_drydep_init been called? + character(len=CS), public, dimension(maxspc) :: drydep_list = '' ! List of dry-dep species + + real(r8), public, allocatable, dimension(:) :: foxd ! reactivity factor for oxidation (dimensioness) + real(r8), public, allocatable, dimension(:) :: drat ! ratio of molecular diffusivity (D_H2O/D_species; dimensionless) + integer, public, allocatable, dimension(:) :: mapping ! mapping to species table + + ! --- Indices for each species --- + integer, public :: h2_ndx, ch4_ndx, co_ndx, pan_ndx, mpan_ndx, so2_ndx, o3_ndx, o3a_ndx, xpan_ndx + + !--------------------------------------------------------------------------- + ! Table 1 from Wesely, Atmos. Environment, 1989, p1293 + ! Table 2 from Sheih, microfiche PB86-218104 and Walcek, Atmos. Environment, 1986, p949 + ! Table 3-5 compiled by P. Hess + ! + ! index #1 : season + ! 1 -> midsummer with lush vegetation + ! 2 -> autumn with unharvested cropland + ! 3 -> late autumn after frost, no snow + ! 4 -> winter, snow on ground, and subfreezing + ! 5 -> transitional spring with partially green short annuals + ! + ! index #2 : landuse type + ! 1 -> urban land + ! 2 -> agricultural land + ! 3 -> range land + ! 4 -> deciduous forest + ! 5 -> coniferous forest + ! 6 -> mixed forest including wetland + ! 7 -> water, both salt and fresh + ! 8 -> barren land, mostly desert + ! 9 -> nonforested wetland + ! 10 -> mixed agricultural and range land + ! 11 -> rocky open areas with low growing shrubs + ! + ! JFL August 2000 + !--------------------------------------------------------------------------- + + !--------------------------------------------------------------------------- + ! table to parameterize the impact of soil moisture on the deposition of H2 and + ! CO on soils (from Sanderson et al., J. Atmos. Chem., 46, 15-28, 2003). + !--------------------------------------------------------------------------- + + !--- deposition of h2 and CO on soils --- + real(r8), parameter, public :: h2_a(NLUse) = & + (/ 0.000_r8, 0.000_r8, 0.270_r8, 0.000_r8, 0.000_r8, & + 0.000_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.000_r8/) + !--- deposition of h2 and CO on soils --- + real(r8), parameter, public :: h2_b(NLUse) = & + (/ 0.000_r8,-41.390_r8, -0.472_r8,-41.900_r8,-41.900_r8, & + -41.900_r8, 0.000_r8, 0.000_r8, 0.000_r8,-41.390_r8, 0.000_r8/) + !--- deposition of h2 and CO on soils --- + real(r8), parameter, public :: h2_c(NLUse) = & + (/ 0.000_r8, 16.850_r8, 1.235_r8, 19.700_r8, 19.700_r8, & + 19.700_r8, 0.000_r8, 0.000_r8, 0.000_r8, 17.700_r8, 1.000_r8/) + + !--- deposition of h2 and CO on soils + ! + !--- ri: Richardson number (dimensionless) + !--- rlu: Resistance of leaves in upper canopy (s.m-1) + !--- rac: Aerodynamic resistance to lower canopy (s.m-1) + !--- rgss: Ground surface resistance for SO2 (s.m-1) + !--- rgso: Ground surface resistance for O3 (s.m-1) + !--- rcls: Lower canopy resistance for SO2 (s.m-1) + !--- rclo: Lower canopy resistance for O3 (s.m-1) + ! + real(r8), public, dimension(NSeas,NLUse) :: ri, rlu, rac, rgss, rgso, rcls, rclo + + data ri (1,1:NLUse) & + /1.e36_r8, 60._r8, 120._r8, 70._r8, 130._r8, 100._r8,1.e36_r8,1.e36_r8, 80._r8, 100._r8, 150._r8/ + data rlu (1,1:NLUse) & + /1.e36_r8,2000._r8,2000._r8,2000._r8,2000._r8,2000._r8,1.e36_r8,1.e36_r8,2500._r8,2000._r8,4000._r8/ + data rac (1,1:NLUse) & + / 100._r8, 200._r8, 100._r8,2000._r8,2000._r8,2000._r8, 0._r8, 0._r8, 300._r8, 150._r8, 200._r8/ + data rgss(1,1:NLUse) & + / 400._r8, 150._r8, 350._r8, 500._r8, 500._r8, 100._r8, 0._r8,1000._r8, 0._r8, 220._r8, 400._r8/ + data rgso(1,1:NLUse) & + / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8,1000._r8, 180._r8, 200._r8/ + data rcls(1,1:NLUse) & + /1.e36_r8,2000._r8,2000._r8,2000._r8,2000._r8,2000._r8,1.e36_r8,1.e36_r8,2500._r8,2000._r8,4000._r8/ + data rclo(1,1:NLUse) & + /1.e36_r8,1000._r8,1000._r8,1000._r8,1000._r8,1000._r8,1.e36_r8,1.e36_r8,1000._r8,1000._r8,1000._r8/ + + data ri (2,1:NLUse) & + /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8, 250._r8, 500._r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8/ + data rlu (2,1:NLUse) & + /1.e36_r8,9000._r8,9000._r8,9000._r8,4000._r8,8000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ + data rac (2,1:NLUse) & + / 100._r8, 150._r8, 100._r8,1500._r8,2000._r8,1700._r8, 0._r8, 0._r8, 200._r8, 120._r8, 140._r8/ + data rgss(2,1:NLUse) & + / 400._r8, 200._r8, 350._r8, 500._r8, 500._r8, 100._r8, 0._r8,1000._r8, 0._r8, 300._r8, 400._r8/ + data rgso(2,1:NLUse) & + / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8, 800._r8, 180._r8, 200._r8/ + data rcls(2,1:NLUse) & + /1.e36_r8,9000._r8,9000._r8,9000._r8,2000._r8,4000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ + data rclo(2,1:NLUse) & + /1.e36_r8, 400._r8, 400._r8, 400._r8,1000._r8, 600._r8,1.e36_r8,1.e36_r8, 400._r8, 400._r8, 400._r8/ + + data ri (3,1:NLUse) & + /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8, 250._r8, 500._r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8/ + data rlu (3,1:NLUse) & + /1.e36_r8,1.e36_r8,9000._r8,9000._r8,4000._r8,8000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ + data rac (3,1:NLUse) & + / 100._r8, 10._r8, 100._r8,1000._r8,2000._r8,1500._r8, 0._r8, 0._r8, 100._r8, 50._r8, 120._r8/ + data rgss(3,1:NLUse) & + / 400._r8, 150._r8, 350._r8, 500._r8, 500._r8, 200._r8, 0._r8,1000._r8, 0._r8, 200._r8, 400._r8/ + data rgso(3,1:NLUse) & + / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8,1000._r8, 180._r8, 200._r8/ + data rcls(3,1:NLUse) & + /1.e36_r8,1.e36_r8,9000._r8,9000._r8,3000._r8,6000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ + data rclo(3,1:NLUse) & + /1.e36_r8,1000._r8, 400._r8, 400._r8,1000._r8, 600._r8,1.e36_r8,1.e36_r8, 800._r8, 600._r8, 600._r8/ + + data ri (4,1:NLUse) & + /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8, 400._r8, 800._r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8/ + data rlu (4,1:NLUse) & + /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,6000._r8,9000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ + data rac (4,1:NLUse) & + / 100._r8, 10._r8, 10._r8,1000._r8,2000._r8,1500._r8, 0._r8, 0._r8, 50._r8, 10._r8, 50._r8/ + data rgss(4,1:NLUse) & + / 100._r8, 100._r8, 100._r8, 100._r8, 100._r8, 100._r8, 0._r8,1000._r8, 100._r8, 100._r8, 50._r8/ + data rgso(4,1:NLUse) & + / 600._r8,3500._r8,3500._r8,3500._r8,3500._r8,3500._r8,2000._r8, 400._r8,3500._r8,3500._r8,3500._r8/ + data rcls(4,1:NLUse) & + /1.e36_r8,1.e36_r8,1.e36_r8,9000._r8, 200._r8, 400._r8,1.e36_r8,1.e36_r8,9000._r8,1.e36_r8,9000._r8/ + data rclo(4,1:NLUse) & + /1.e36_r8,1000._r8,1000._r8, 400._r8,1500._r8, 600._r8,1.e36_r8,1.e36_r8, 800._r8,1000._r8, 800._r8/ + + data ri (5,1:NLUse) & + /1.e36_r8, 120._r8, 240._r8, 140._r8, 250._r8, 190._r8,1.e36_r8,1.e36_r8, 160._r8, 200._r8, 300._r8/ + data rlu (5,1:NLUse) & + /1.e36_r8,4000._r8,4000._r8,4000._r8,2000._r8,3000._r8,1.e36_r8,1.e36_r8,4000._r8,4000._r8,8000._r8/ + data rac (5,1:NLUse) & + / 100._r8, 50._r8, 80._r8,1200._r8,2000._r8,1500._r8, 0._r8, 0._r8, 200._r8, 60._r8, 120._r8/ + data rgss(5,1:NLUse) & + / 500._r8, 150._r8, 350._r8, 500._r8, 500._r8, 200._r8, 0._r8,1000._r8, 0._r8, 250._r8, 400._r8/ + data rgso(5,1:NLUse) & + / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8,1000._r8, 180._r8, 200._r8/ + data rcls(5,1:NLUse) & + /1.e36_r8,4000._r8,4000._r8,4000._r8,2000._r8,3000._r8,1.e36_r8,1.e36_r8,4000._r8,4000._r8,8000._r8/ + data rclo(5,1:NLUse) & + /1.e36_r8,1000._r8, 500._r8, 500._r8,1500._r8, 700._r8,1.e36_r8,1.e36_r8, 600._r8, 800._r8, 800._r8/ + + !--------------------------------------------------------------------------- + ! ... roughness length + !--------------------------------------------------------------------------- + real(r8), public, dimension(NSeas,NLUse) :: z0 + + data z0 (1,1:NLUse) & + /1.000_r8,0.250_r8,0.050_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.150_r8,0.100_r8,0.100_r8/ + data z0 (2,1:NLUse) & + /1.000_r8,0.100_r8,0.050_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.100_r8,0.080_r8,0.080_r8/ + data z0 (3,1:NLUse) & + /1.000_r8,0.005_r8,0.050_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.100_r8,0.020_r8,0.060_r8/ + data z0 (4,1:NLUse) & + /1.000_r8,0.001_r8,0.001_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.001_r8,0.001_r8,0.040_r8/ + data z0 (5,1:NLUse) & + /1.000_r8,0.030_r8,0.020_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.010_r8,0.030_r8,0.060_r8/ + + !real(r8), private, dimension(11,5), parameter :: z0xxx = reshape ( & + ! (/ 1.000,0.250,0.050,1.000,1.000,1.000,0.0006,0.002,0.150,0.100,0.100 , & + ! 1.000,0.100,0.050,1.000,1.000,1.000,0.0006,0.002,0.100,0.080,0.080 , & + ! 1.000,0.005,0.050,1.000,1.000,1.000,0.0006,0.002,0.100,0.020,0.060 , & + ! 1.000,0.001,0.001,1.000,1.000,1.000,0.0006,0.002,0.001,0.001,0.040 , & + ! 1.000,0.030,0.020,1.000,1.000,1.000,0.0006,0.002,0.010,0.030,0.060 /), (/11,5/) ) + + !--------------------------------------------------------------------------- + ! public chemical data + !--------------------------------------------------------------------------- + + !--- data for foxd (reactivity factor for oxidation) ---- + real(r8), public, parameter :: dfoxd(n_species_table) = & + (/ 1._r8 & ! OX + ,1._r8 & ! H2O2 + ,1._r8 & ! OH + ,.1_r8 & ! HO2 + ,1.e-36_r8 & ! CO + ,1.e-36_r8 & ! CH4 + ,1._r8 & ! CH3O2 + ,1._r8 & ! CH3OOH + ,1._r8 & ! CH2O + ,1._r8 & ! HCOOH + ,0._r8 & ! NO + ,.1_r8 & ! NO2 + ,1.e-36_r8 & ! HNO3 + ,1.e-36_r8 & ! CO2 + ,1.e-36_r8 & ! NH3 + ,.1_r8 & ! N2O5 + ,1._r8 & ! NO3 + ,1._r8 & ! CH3OH + ,.1_r8 & ! HO2NO2 + ,1._r8 & ! O1D + ,1.e-36_r8 & ! C2H6 + ,.1_r8 & ! C2H5O2 + ,.1_r8 & ! PO2 + ,.1_r8 & ! MACRO2 + ,.1_r8 & ! ISOPO2 + ,1.e-36_r8 & ! C4H10 + ,1._r8 & ! CH3CHO + ,1._r8 & ! C2H5OOH + ,1.e-36_r8 & ! C3H6 + ,1._r8 & ! POOH + ,1.e-36_r8 & ! C2H4 + ,.1_r8 & ! PAN + ,1._r8 & ! CH3COOOH + ,1.e-36_r8 & ! MTERP + ,1._r8 & ! GLYOXAL + ,1._r8 & ! CH3COCHO + ,1._r8 & ! GLYALD + ,.1_r8 & ! CH3CO3 + ,1.e-36_r8 & ! C3H8 + ,.1_r8 & ! C3H7O2 + ,1._r8 & ! CH3COCH3 + ,1._r8 & ! C3H7OOH + ,.1_r8 & ! RO2 + ,1._r8 & ! ROOH + ,1.e-36_r8 & ! Rn + ,1.e-36_r8 & ! ISOP + ,1._r8 & ! MVK + ,1._r8 & ! MACR + ,1._r8 & ! C2H5OH + ,1._r8 & ! ONITR + ,.1_r8 & ! ONIT + ,.1_r8 & ! ISOPNO3 + ,1._r8 & ! HYDRALD + ,1.e-36_r8 & ! HCN + ,1.e-36_r8 & ! CH3CN + ,1.e-36_r8 & ! SO2 + ,0.1_r8 & ! SOAGff0 + ,0.1_r8 & ! SOAGff1 + ,0.1_r8 & ! SOAGff2 + ,0.1_r8 & ! SOAGff3 + ,0.1_r8 & ! SOAGff4 + ,0.1_r8 & ! SOAGbg0 + ,0.1_r8 & ! SOAGbg1 + ,0.1_r8 & ! SOAGbg2 + ,0.1_r8 & ! SOAGbg3 + ,0.1_r8 & ! SOAGbg4 + ,0.1_r8 & ! SOAG0 + ,0.1_r8 & ! SOAG1 + ,0.1_r8 & ! SOAG2 + ,0.1_r8 & ! SOAG3 + ,0.1_r8 & ! SOAG4 + ,0.1_r8 & ! IVOC + ,0.1_r8 & ! SVOC + ,0.1_r8 & ! IVOCbb + ,0.1_r8 & ! IVOCff + ,0.1_r8 & ! SVOCbb + ,0.1_r8 & ! SVOCff + ,1.e-36_r8 & ! N2O + ,1.e-36_r8 & ! H2 + ,1.e-36_r8 & ! C2H2 + ,1._r8 & ! CH3COOH + ,1._r8 & ! EOOH + ,1._r8 & ! HYAC + ,1.e-36_r8 & ! BIGENE + ,1.e-36_r8 & ! BIGALK + ,1._r8 & ! MEK + ,1._r8 & ! MEKOOH + ,1._r8 & ! MACROOH + ,1._r8 & ! MPAN + ,1._r8 & ! ALKNIT + ,1._r8 & ! NOA + ,1._r8 & ! ISOPNITA + ,1._r8 & ! ISOPNITB + ,1._r8 & ! ISOPNOOH + ,1._r8 & ! NC4CHO + ,1._r8 & ! NC4CH2OH + ,1._r8 & ! TERPNIT + ,1._r8 & ! NTERPOOH + ,1._r8 & ! ALKOOH + ,1._r8 & ! BIGALD + ,1._r8 & ! HPALD + ,1._r8 & ! IEPOX + ,1._r8 & ! XOOH + ,1._r8 & ! ISOPOOH + ,1.e-36_r8 & ! TOLUENE + ,1._r8 & ! CRESOL + ,1._r8 & ! TOLOOH + ,1.e-36_r8 & ! BENZENE + ,1._r8 & ! PHENOL + ,1._r8 & ! BEPOMUC + ,1._r8 & ! PHENOOH + ,1._r8 & ! C6H5OOH + ,1._r8 & ! BENZOOH + ,1._r8 & ! BIGALD1 + ,1._r8 & ! BIGALD2 + ,1._r8 & ! BIGALD3 + ,1._r8 & ! BIGALD4 + ,1._r8 & ! TEPOMUC + ,1._r8 & ! BZOOH + ,1._r8 & ! BZALD + ,1._r8 & ! PBZNIT + ,1.e-36_r8 & ! XYLENES + ,1._r8 & ! XYLOL + ,1._r8 & ! XYLOLOOH + ,1._r8 & ! XYLENOOH + ,1.e-36_r8 & ! BCARY + ,1._r8 & ! TERPOOH + ,1._r8 & ! TERPROD1 + ,1._r8 & ! TERPROD2 + ,1._r8 & ! TERP2OOH + ,1.e-36_r8 & ! DMS + ,1.e-36_r8 & ! H2SO4 + ,1._r8 & ! HONITR + ,1._r8 & ! MACRN + ,1._r8 & ! MVKN + ,1._r8 & ! ISOPN2B + ,1._r8 & ! ISOPN3B + ,1._r8 & ! ISOPN4D + ,1._r8 & ! ISOPN1D + ,1._r8 & ! ISOPNOOHD + ,1._r8 & ! ISOPNOOHB + ,1._r8 & ! ISOPNBNO3 + ,1._r8 & ! NO3CH2CHO + ,1._r8 & ! HYPERACET + ,1._r8 & ! HCOCH2OOH + ,1._r8 & ! DHPMPAL + ,1._r8 & ! MVKOOH + ,1._r8 & ! ISOPOH + ,1._r8 & ! ISOPFDN + ,1._r8 & ! ISOPFNP + ,1._r8 & ! INHEB + ,1._r8 & ! HMHP + ,1._r8 & ! HPALD1 + ,1._r8 & ! INHED + ,1._r8 & ! HPALD4 + ,1._r8 & ! ISOPHFP + ,1._r8 & ! HPALDB1C + ,1._r8 & ! HPALDB4C + ,1._r8 & ! ICHE + ,1._r8 & ! ISOPFDNC + ,1._r8 & ! ISOPFNC + ,1._r8 & ! TERPNT + ,1._r8 & ! TERPNS + ,1._r8 & ! TERPNT1 + ,1._r8 & ! TERPNS1 + ,1._r8 & ! TERPNPT + ,1._r8 & ! TERPNPS + ,1._r8 & ! TERPNPT1 + ,1._r8 & ! TERPNPS1 + ,1._r8 & ! TERPFDN + ,1._r8 & ! SQTN + ,1._r8 & ! TERPHFN + ,1._r8 & ! TERP1OOH + ,1._r8 & ! TERPDHDP + ,1._r8 & ! TERPF2 + ,1._r8 & ! TERPF1 + ,1._r8 & ! TERPA + ,1._r8 & ! TERPA2 + ,1._r8 & ! TERPK + ,1._r8 & ! TERPAPAN + ,1._r8 & ! TERPACID + ,1._r8 & ! TERPA2PAN + ,1.e-36_r8 & ! APIN + ,1.e-36_r8 & ! BPIN + ,1.e-36_r8 & ! LIMON + ,1.e-36_r8 & ! MYRC + ,1._r8 & ! TERPACID2 + ,1._r8 & ! TERPACID3 + ,1._r8 & ! TERPA3PAN + ,1._r8 & ! TERPOOHL + ,1._r8 & ! TERPA3 + ,1._r8 & ! TERP2AOOH + /) -contains + ! PRIVATE DATA: + + Interface seq_drydep_setHCoeff ! overload subroutine + Module Procedure set_hcoeff_scalar + Module Procedure set_hcoeff_vector + End Interface + + real(r8), private, parameter :: small_value = 1.e-36_r8 !--- smallest value to use --- + + !--------------------------------------------------------------------------- + ! private chemical data + !--------------------------------------------------------------------------- + + !--- Names of species that can work with --- + character(len=20), public, parameter :: species_name_table(n_species_table) = & + (/ 'OX ' & + ,'H2O2 ' & + ,'OH ' & + ,'HO2 ' & + ,'CO ' & + ,'CH4 ' & + ,'CH3O2 ' & + ,'CH3OOH ' & + ,'CH2O ' & + ,'HCOOH ' & + ,'NO ' & + ,'NO2 ' & + ,'HNO3 ' & + ,'CO2 ' & + ,'NH3 ' & + ,'N2O5 ' & + ,'NO3 ' & + ,'CH3OH ' & + ,'HO2NO2 ' & + ,'O1D ' & + ,'C2H6 ' & + ,'C2H5O2 ' & + ,'PO2 ' & + ,'MACRO2 ' & + ,'ISOPO2 ' & + ,'C4H10 ' & + ,'CH3CHO ' & + ,'C2H5OOH ' & + ,'C3H6 ' & + ,'POOH ' & + ,'C2H4 ' & + ,'PAN ' & + ,'CH3COOOH ' & + ,'MTERP ' & + ,'GLYOXAL ' & + ,'CH3COCHO ' & + ,'GLYALD ' & + ,'CH3CO3 ' & + ,'C3H8 ' & + ,'C3H7O2 ' & + ,'CH3COCH3 ' & + ,'C3H7OOH ' & + ,'RO2 ' & + ,'ROOH ' & + ,'Rn ' & + ,'ISOP ' & + ,'MVK ' & + ,'MACR ' & + ,'C2H5OH ' & + ,'ONITR ' & + ,'ONIT ' & + ,'ISOPNO3 ' & + ,'HYDRALD ' & + ,'HCN ' & + ,'CH3CN ' & + ,'SO2 ' & + ,'SOAGff0 ' & + ,'SOAGff1 ' & + ,'SOAGff2 ' & + ,'SOAGff3 ' & + ,'SOAGff4 ' & + ,'SOAGbg0 ' & + ,'SOAGbg1 ' & + ,'SOAGbg2 ' & + ,'SOAGbg3 ' & + ,'SOAGbg4 ' & + ,'SOAG0 ' & + ,'SOAG1 ' & + ,'SOAG2 ' & + ,'SOAG3 ' & + ,'SOAG4 ' & + ,'IVOC ' & + ,'SVOC ' & + ,'IVOCbb ' & + ,'IVOCff ' & + ,'SVOCbb ' & + ,'SVOCff ' & + ,'N2O ' & + ,'H2 ' & + ,'C2H2 ' & + ,'CH3COOH ' & + ,'EOOH ' & + ,'HYAC ' & + ,'BIGENE ' & + ,'BIGALK ' & + ,'MEK ' & + ,'MEKOOH ' & + ,'MACROOH ' & + ,'MPAN ' & + ,'ALKNIT ' & + ,'NOA ' & + ,'ISOPNITA ' & + ,'ISOPNITB ' & + ,'ISOPNOOH ' & + ,'NC4CHO ' & + ,'NC4CH2OH ' & + ,'TERPNIT ' & + ,'NTERPOOH ' & + ,'ALKOOH ' & + ,'BIGALD ' & + ,'HPALD ' & + ,'IEPOX ' & + ,'XOOH ' & + ,'ISOPOOH ' & + ,'TOLUENE ' & + ,'CRESOL ' & + ,'TOLOOH ' & + ,'BENZENE ' & + ,'PHENOL ' & + ,'BEPOMUC ' & + ,'PHENOOH ' & + ,'C6H5OOH ' & + ,'BENZOOH ' & + ,'BIGALD1 ' & + ,'BIGALD2 ' & + ,'BIGALD3 ' & + ,'BIGALD4 ' & + ,'TEPOMUC ' & + ,'BZOOH ' & + ,'BZALD ' & + ,'PBZNIT ' & + ,'XYLENES ' & + ,'XYLOL ' & + ,'XYLOLOOH ' & + ,'XYLENOOH ' & + ,'BCARY ' & + ,'TERPOOH ' & + ,'TERPROD1 ' & + ,'TERPROD2 ' & + ,'TERP2OOH ' & + ,'DMS ' & + ,'H2SO4 ' & + ,'HONITR ' & + ,'MACRN ' & + ,'MVKN ' & + ,'ISOPN2B ' & + ,'ISOPN3B ' & + ,'ISOPN4D ' & + ,'ISOPN1D ' & + ,'ISOPNOOHD' & + ,'ISOPNOOHB' & + ,'ISOPNBNO3' & + ,'NO3CH2CHO' & + ,'HYPERACET' & + ,'HCOCH2OOH' & + ,'DHPMPAL ' & + ,'MVKOOH ' & + ,'ISOPOH ' & + ,'ISOPFDN ' & + ,'ISOPFNP ' & + ,'INHEB ' & + ,'HMHP ' & + ,'HPALD1 ' & + ,'INHED ' & + ,'HPALD4 ' & + ,'ISOPHFP ' & + ,'HPALDB1C ' & + ,'HPALDB4C ' & + ,'ICHE ' & + ,'ISOPFDNC ' & + ,'ISOPFNC ' & + ,'TERPNT ' & + ,'TERPNS ' & + ,'TERPNT1 ' & + ,'TERPNS1 ' & + ,'TERPNPT ' & + ,'TERPNPS ' & + ,'TERPNPT1 ' & + ,'TERPNPS1 ' & + ,'TERPFDN ' & + ,'SQTN ' & + ,'TERPHFN ' & + ,'TERP1OOH ' & + ,'TERPDHDP ' & + ,'TERPF2 ' & + ,'TERPF1 ' & + ,'TERPA ' & + ,'TERPA2 ' & + ,'TERPK ' & + ,'TERPAPAN ' & + ,'TERPACID ' & + ,'TERPA2PAN' & + ,'APIN ' & + ,'BPIN ' & + ,'LIMON ' & + ,'MYRC ' & + ,'TERPACID2' & + ,'TERPACID3' & + ,'TERPA3PAN' & + ,'TERPOOHL ' & + ,'TERPA3 ' & + ,'TERP2AOOH' & + /) + + !--- data for effective Henry's Law coefficient --- + real(r8), public, parameter :: dheff(n_species_table*6) = & + (/1.03e-02_r8, 2830._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! OX + ,8.70e+04_r8, 7320._r8,2.2e-12_r8,-3730._r8,0._r8 , 0._r8 & ! H2O2 + ,3.90e+01_r8, 4300._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! OH + ,6.90e+02_r8, 5900._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HO2 + ,9.81e-04_r8, 1650._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CO + ,1.41e-03_r8, 1820._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH4 + ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3O2 + ,3.00e+02_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3OOH + ,3.23e+03_r8, 7100._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH2O + ,8.90e+03_r8, 6100._r8,1.8e-04_r8, -20._r8,0._r8 , 0._r8 & ! HCOOH + ,1.92e-03_r8, 1762._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NO + ,1.20e-02_r8, 2440._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NO2 + ,2.10e+05_r8, 8700._r8,2.2e+01_r8, 0._r8,0._r8 , 0._r8 & ! HNO3 + ,3.44e-02_r8, 2715._r8,4.3e-07_r8,-1000._r8,4.7e-11_r8,-1760._r8 & ! CO2 + ,6.02e+01_r8, 4160._r8,1.7e-05_r8,-4325._r8,1.0e-14_r8,-6716._r8 & ! NH3 + ,2.14e+00_r8, 3362._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! N2O5 + ,3.80e-02_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NO3 + ,2.03e+02_r8, 5645._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3OH + ,4.00e+01_r8, 8400._r8,1.3e-06_r8, 0._r8,0._r8 , 0._r8 & ! HO2NO2 + ,1.00e-16_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! O1D + ,1.88e-03_r8, 2750._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C2H6 + ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C2H5O2 + ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! PO2 + ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MACRO2 + ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPO2 + ,1.70e-03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C4H10 + ,1.29e+01_r8, 5890._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3CHO + ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C2H5OOH + ,5.57e-03_r8, 2800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C3H6 + ,1.50e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! POOH + ,5.96e-03_r8, 2200._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C2H4 + ,2.80e+00_r8, 5730._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! PAN + ,8.37e+02_r8, 5310._r8,1.8e-04_r8, -20._r8,0._r8 , 0._r8 & ! CH3COOOH + ,2.94e-02_r8, 1800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MTERP + ,4.19e+05_r8, 7480._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! GLYOXAL + ,3.50e+03_r8, 7545._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3COCHO + ,4.00e+04_r8, 4630._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! GLYALD + ,1.00e-01_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3CO3 + ,1.51e-03_r8, 3120._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C3H8 + ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C3H7O2 + ,2.78e+01_r8, 5530._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3COCH3 + ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C3H7OOH + ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! RO2 + ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ROOH + ,0.00e+00_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! Rn + ,3.45e-02_r8, 4400._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOP + ,4.10e+01_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MVK + ,6.50e+00_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MACR + ,1.90e+02_r8, 6500._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C2H5OH + ,1.44e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ONITR + ,1.00e+03_r8, 6000._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ONIT + ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNO3 + ,1.10e+05_r8, 6000._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HYDRALD + ,9.02e+00_r8, 8258._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HCN + ,5.28e+01_r8, 3970._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3CN + ,1.36e+00_r8, 3100._r8,1.30e-02_r8,1960._r8,6.6e-08_r8, 1500._r8 & ! SO2 + ,1.3e+07_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGff0 + ,3.2e+05_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGff1 + ,4.0e+05_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGff2 + ,1.3e+05_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGff3 + ,1.6e+05_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGff4 + ,7.9e+11_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGbg0 + ,6.3e+10_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGbg1 + ,3.2e+09_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGbg2 + ,6.3e+08_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGbg3 + ,3.2e+07_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGbg4 + ,4.0e+11_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAG0 + ,3.2e+10_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAG1 + ,1.6e+09_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAG2 + ,3.2e+08_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAG3 + ,1.6e+07_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAG4 + ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! IVOC + ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SVOC + ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! IVOCbb + ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! IVOCff + ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SVOCbb + ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SVOCff + ,2.42e-02_r8, 2710._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! N2O + ,7.9e-04_r8, 530._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! H2 + ,4.14e-02_r8, 1890._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C2H2 + ,4.1e+03_r8, 6200._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3COOH + ,1.9e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! EOOH + ,1.46e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HYAC + ,5.96e-03_r8, 2365._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGENE + ,1.24e-03_r8, 3010._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGALK + ,1.80e+01_r8, 5740._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MEK + ,6.4e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MEKOOH + ,4.4e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MACROOH + ,1.72e+00_r8, 5700._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MPAN + ,1.01e+00_r8, 5790._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ALKNIT + ,1.e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NOA + ,8.34e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNITA + ,4.82e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNITB + ,8.75e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNOOH + ,1.46e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NC4CHO + ,4.02e+04_r8, 9500._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NC4CH2OH + ,8.41e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNIT + ,6.67e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NTERPOOH + ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ALKOOH + ,9.6e+00_r8, 6220._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGALD + ,2.30e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HPALD + ,3.e+07_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! IEPOX + ,1.e+11_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! XOOH + ,3.5e+06_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPOOH + ,1.5e-01_r8, 4300._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TOLUENE + ,5.67e+02_r8, 5800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CRESOL + ,2.30e+04_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TOLOOH + ,1.8e-01_r8, 3800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BENZENE + ,2.84e+03_r8, 2700._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! PHENOL + ,3.e+07_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BEPOMUC + ,1.5e+06_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! PHENOOH + ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C6H5OOH + ,2.3e+03_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BENZOOH + ,1.e+05_r8, 5890._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGALD1 + ,2.9e+04_r8, 5890._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGALD2 + ,2.2e+04_r8, 5890._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGALD3 + ,2.2e+04_r8, 5890._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGALD4 + ,2.5e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TEPOMUC + ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BZOOH + ,3.24e+01_r8, 6300._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BZALD + ,2.8e+00_r8, 5730._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! PBZNIT + ,2.e-01_r8, 4300._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! XYLENES + ,1.01e+03_r8, 6800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! XYLOL + ,1.9e+06_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! XYLOLOOH + ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! XYLENOOH + ,5.57e-03_r8, 2800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BCARY + ,3.6e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPOOH + ,3.92e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPROD1 + ,7.20e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPROD2 + ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERP2OOH + ,5.4e-01_r8, 3460._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! DMS + ,1.e+11_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! H2SO4 + ,2.64e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HONITR + ,4.14e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MACRN + ,1.84e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MVKN + ,8.34e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPN2B + ,8.34e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPN3B + ,4.82e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPN4D + ,4.82e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPN1D + ,9.67e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNOOHD + ,6.61e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNOOHB + ,8.34e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNBNO3 + ,3.39e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NO3CH2CHO + ,1.16e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HYPERACET + ,2.99e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HCOCH2OOH + ,9.37e+07_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! DHPMPAL + ,1.24e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MVKOOH + ,8.77e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPOH + ,5.02e+08_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPFDN + ,2.97e+11_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPFNP + ,1.05e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! INHEB + ,1.70e+06_r8, 9870._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HMHP + ,2.30e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HPALD1 + ,1.51e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! INHED + ,2.30e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HPALD4 + ,7.60e+09_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPHFP + ,5.43e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HPALDB1C + ,5.43e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HPALDB4C + ,2.09e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ICHE + ,7.16e+09_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPFDNC + ,1.41e+11_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPFNC + ,8.41e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNT + ,8.41e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNS + ,8.55e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNT1 + ,8.55e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNS1 + ,6.67e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNPT + ,6.67e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNPS + ,6.78e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNPT1 + ,6.78e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNPS1 + ,1.65e+09_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPFDN + ,9.04e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SQTN + ,7.53e+11_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPHFN + ,3.64e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERP1OOH + ,3.41e+14_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPDHDP + ,6.54e+01_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPF2 + ,4.05e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPF1 + ,3.92e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPA + ,7.20e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPA2 + ,6.39e+01_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPK + ,7.94e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPAPAN + ,5.63e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPACID + ,9.59e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPA2PAN + ,2.94e-02_r8, 1800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! APIN + ,1.52e-02_r8, 4500._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BPIN + ,4.86e-02_r8, 4600._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! LIMON + ,7.30e-02_r8, 2800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MYRC + ,2.64e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPACID2 + ,3.38e+09_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPACID3 + ,1.23e+07_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPA3PAN + ,4.41e+12_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPOOHL + ,1.04e+08_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPA3 + ,3.67e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERP2AOOH + /) + + real(r8), private, parameter :: wh2o = SHR_CONST_MWWV + real(r8), private, parameter :: mol_wgts(n_species_table) = & + (/ 47.9981995_r8, 34.0135994_r8, 17.0067997_r8, 33.0061989_r8, 28.0104008_r8, & + 16.0405998_r8, 47.0320015_r8, 48.0393982_r8, 30.0251999_r8, 46.0246010_r8, & + 30.0061398_r8, 46.0055389_r8, 63.0123405_r8, 44.0098000_r8, 17.0289402_r8, & + 108.010483_r8, 62.0049400_r8, 32.0400009_r8, 79.0117416_r8, 15.9994001_r8, & + 30.0664005_r8, 61.0578003_r8, 91.0830002_r8, 119.093399_r8, 117.119797_r8, & + 58.1180000_r8, 44.0509987_r8, 62.0652008_r8, 42.0774002_r8, 92.0904007_r8, & + 28.0515995_r8, 121.047943_r8, 76.0497971_r8, 136.228394_r8, 58.0355988_r8, & + 72.0614014_r8, 60.0503998_r8, 75.0423965_r8, 44.0922012_r8, 75.0836029_r8, & + 58.0768013_r8, 76.0910034_r8, 89.070126_r8, 90.078067_r8, 222.000000_r8, & + 68.1141968_r8, 70.0877991_r8, 70.0877991_r8, 46.0657997_r8, 147.125946_r8, & + 119.074341_r8, 162.117935_r8, 100.112999_r8, 27.0256_r8 , 41.0524_r8 , & + 64.064800_r8, 250._r8, 250._r8, 250._r8, 250._r8, & + 250._r8, 250._r8, 250._r8, 250._r8, 250._r8, & + 250._r8, 250._r8, 250._r8, 250._r8, 250._r8, & + 250._r8, 170.3_r8, 170.3_r8, 170.3_r8, 170.3_r8, & + 170.3_r8, 170.3_r8, 44.0129_r8, 2.0148_r8, 26.0368_r8, & + 60.0504_r8, 78.0646_r8, 74.0762_r8, 56.1032_r8, 72.1438_r8, & + 72.1026_r8, 104.101_r8, 120.101_r8, 147.085_r8, 133.141_r8, & + 119.074_r8, 147.126_r8, 147.126_r8, 163.125_r8, 145.111_r8, & + 147.126_r8, 215.24_r8, 231.24_r8, 104.143_r8, 98.0982_r8, & + 116.112_r8, 118.127_r8, 150.126_r8, 118.127_r8, 92.1362_r8, & + 108.136_r8, 174.148_r8, 78.1104_r8, 94.1098_r8, 126.109_r8, & + 176.122_r8, 110.109_r8, 160.122_r8, 84.0724_r8, 98.0982_r8, & + 98.0982_r8, 112.124_r8, 140.134_r8, 124.135_r8, 106.121_r8, & + 183.118_r8, 106.162_r8, 122.161_r8, 204.173_r8, 188.174_r8, & + 204.343_r8, 186.241_r8, 168.227_r8, 154.201_r8, 200.226_r8, & + 62.1324_r8, 98.0784_r8, 135.118733_r8, 149.102257_r8, 149.102257_r8, & + 147.129469_r8, 147.129469_r8, 147.129469_r8, 147.129469_r8, 163.128874_r8, & + 163.128874_r8, 147.129469_r8, 105.049617_r8, 90.078067_r8, 76.05145_r8, & + 136.103494_r8, 120.104089_r8, 102.131897_r8, 226.141733_r8, 197.143565_r8, & + 163.128874_r8, 64.040714_r8, 116.11542_r8, 163.128874_r8, 116.11542_r8, & + 150.130112_r8, 116.11542_r8, 116.11542_r8, 116.11542_r8, 224.125851_r8, & + 195.127684_r8, 215.246675_r8, 215.246675_r8, 215.246675_r8, 215.246675_r8, & + 231.24608_r8, 231.24608_r8, 231.24608_r8, 231.24608_r8, 294.258938_r8, & + 283.36388_r8, 265.260771_r8, 186.248507_r8, 236.262604_r8, 110.153964_r8, & + 168.233221_r8, 168.233221_r8, 154.206603_r8, 138.207199_r8, 245.229603_r8, & + 200.232031_r8, 231.202986_r8, 136.228394_r8, 136.228394_r8, 136.228394_r8, & + 136.228394_r8, 186.205413_r8, 202.204818_r8, 247.202391_r8, 218.247317_r8, & + 170.206008_r8, 186.248507_r8 /) + + +!=============================================================================== +CONTAINS +!=============================================================================== subroutine seq_drydep_readnl(NLFilename, drydep_nflds) + !======================================================================== + ! reads drydep_inparm namelist and determines the number of drydep velocity + ! fields that are sent from the land component + !======================================================================== + character(len=*), intent(in) :: NLFilename ! Namelist filename integer, intent(out) :: drydep_nflds - call shr_drydep_readnl(NLFilename, drydep_nflds) + !----- local ----- + integer :: i ! Indices + integer :: unitn ! namelist unit number + integer :: ierr ! error code + logical :: exists ! if file exists or not + type(ESMF_VM) :: vm + integer :: localPet + integer :: mpicom + integer :: rc + character(*),parameter :: F00 = "('(seq_drydep_read) ',8a)" + character(*),parameter :: FI1 = "('(seq_drydep_init) ',a,I2)" + character(*),parameter :: subName = '(seq_drydep_read) ' + !----------------------------------------------------------------------------- + + namelist /drydep_inparm/ drydep_list, drydep_method + + !----------------------------------------------------------------------------- + ! Read namelist and figure out the drydep field list to pass + ! First check if file exists and if not, n_drydep will be zero + !----------------------------------------------------------------------------- - lnd_drydep = drydep_nflds>0 + rc = ESMF_SUCCESS + drydep_nflds = 0 + + !--- Open and read namelist --- + if ( len_trim(NLFilename) == 0 )then + call shr_sys_abort( subName//'ERROR: nlfilename not set' ) + end if + + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_VMGet(vm, localPet=localPet, mpiCommunicator=mpicom, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + if (localPet==0) then + inquire( file=trim(NLFileName), exist=exists) + if ( exists ) then + open(newunit=unitn, file=trim(NLFilename), status='old' ) + write(s_logunit,F00) 'Read in drydep_inparm namelist from: ', trim(NLFilename) + call shr_nl_find_group_name(unitn, 'drydep_inparm', ierr) + if (ierr == 0) then + ! Note that ierr /= 0, no namelist is present. + read(unitn, drydep_inparm, iostat=ierr) + if (ierr > 0) then + call shr_sys_abort( 'problem on read of drydep_inparm namelist in seq_drydep_readnl') + end if + endif + close( unitn ) + end if + end if + call shr_mpi_bcast( drydep_list, mpicom ) + call shr_mpi_bcast( drydep_method, mpicom ) + + do i=1,maxspc + if(len_trim(drydep_list(i)) > 0) then + drydep_nflds=drydep_nflds+1 + endif + enddo + + ! set module variable + n_drydep = drydep_nflds + + ! Make sure method is valid and determine if land is passing drydep fields + lnd_drydep = (drydep_nflds>0 .and. drydep_method == DD_XLND) + if (localpet==0) then + write(s_logunit,*) 'seq_drydep_read: drydep_method: ', trim(drydep_method) + if ( drydep_nflds == 0 )then + write(s_logunit,F00) 'No dry deposition fields will be transfered' + else + write(s_logunit,FI1) 'Number of dry deposition fields transfered is ', drydep_nflds + end if + end if + + if ( trim(drydep_method)/=trim(DD_XATM) .and. & + trim(drydep_method)/=trim(DD_XLND) .and. & + trim(drydep_method)/=trim(DD_TABL) ) then + write(s_logunit,*) 'seq_drydep_read: drydep_method : ', trim(drydep_method) + write(s_logunit,*) 'seq_drydep_read: drydep_method must be set to : ', & + DD_XATM,', ', DD_XLND,', or ', DD_TABL + call shr_sys_abort('seq_drydep_read: incorrect dry deposition method specification') + endif + + if (.not. drydep_initialized) then + call seq_drydep_init() + end if end subroutine seq_drydep_readnl +!==================================================================================== + + subroutine seq_drydep_init( ) + + !======================================================================== + ! Initialization of dry deposition fields + ! reads drydep_inparm namelist and sets up CCSM driver list of fields for + ! land-atmosphere communications. + !======================================================================== + + !----- local ----- + integer :: i, l ! Indices + character(len=32) :: test_name ! field test name + + !----- formats ----- + character(*),parameter :: subName = '(seq_drydep_init) ' + character(*),parameter :: F00 = "('(seq_drydep_init) ',8a)" + + !----------------------------------------------------------------------------- + ! Return if this routine has already been called (e.g. cam and clm both call this) + !----------------------------------------------------------------------------- + if(allocated(foxd)) return + !----------------------------------------------------------------------------- + ! Allocate and fill foxd, drat and mapping as well as species indices + !----------------------------------------------------------------------------- + + if ( n_drydep > 0 ) then + + allocate( foxd(n_drydep) ) + allocate( drat(n_drydep) ) + allocate( mapping(n_drydep) ) + + ! This initializes these variables to infinity. + foxd = shr_infnan_posinf + drat = shr_infnan_posinf + + mapping(:) = 0 + + end if + + h2_ndx=-1; ch4_ndx=-1; co_ndx=-1; mpan_ndx = -1; pan_ndx = -1; so2_ndx=-1; o3_ndx=-1; xpan_ndx=-1 + + !--- Loop over drydep species that need to be worked with --- + do i=1,n_drydep + if ( len_trim(drydep_list(i))==0 ) exit + + test_name = drydep_list(i) + + if( trim(test_name) == 'O3' ) then + test_name = 'OX' + end if + + !--- Figure out if species maps to a species in the species table --- + do l = 1,n_species_table + if( trim( test_name ) == trim( species_name_table(l) ) ) then + mapping(i) = l + exit + end if + end do + + !--- If it doesn't map to a species in the species table find species close enough --- + if( mapping(i) < 1 ) then + select case( trim(test_name) ) + case( 'O3S', 'O3INERT' ) + test_name = 'OX' + case( 'Pb' ) + test_name = 'HNO3' + case( 'SOGM','SOGI','SOGT','SOGB','SOGX' ) + test_name = 'CH3OOH' + case( 'SOA', 'SO4', 'CB1', 'CB2', 'OC1', 'OC2', 'NH4', 'SA1', 'SA2', 'SA3', 'SA4' ) + test_name = 'OX' ! this is just a place holder. values are explicitly set below + case( 'SOAM', 'SOAI', 'SOAT', 'SOAB', 'SOAX' ) + test_name = 'OX' ! this is just a place holder. values are explicitly set below + case( 'SOAGbb0' ) + test_name = 'SOAGff0' + case( 'SOAGbb1' ) + test_name = 'SOAGff1' + case( 'SOAGbb2' ) + test_name = 'SOAGff2' + case( 'SOAGbb3' ) + test_name = 'SOAGff3' + case( 'SOAGbb4' ) + test_name = 'SOAGff4' + case( 'O3A' ) + test_name = 'OX' + case( 'XMPAN' ) + test_name = 'MPAN' + case( 'XPAN' ) + test_name = 'PAN' + case( 'XNO' ) + test_name = 'NO' + case( 'XNO2' ) + test_name = 'NO2' + case( 'XHNO3' ) + test_name = 'HNO3' + case( 'XONIT' ) + test_name = 'ONIT' + case( 'XONITR' ) + test_name = 'ONITR' + case( 'XHO2NO2') + test_name = 'HO2NO2' + case( 'XNH4NO3' ) + test_name = 'HNO3' + case( 'NH4NO3' ) + test_name = 'HNO3' + case default + test_name = 'blank' + end select + + !--- If found a match check the species table again --- + if( trim(test_name) /= 'blank' ) then + do l = 1,n_species_table + if( trim( test_name ) == trim( species_name_table(l) ) ) then + mapping(i) = l + exit + end if + end do + else + write(s_logunit,F00) trim(drydep_list(i)),' not in tables; will have dep vel = 0' + call shr_sys_abort( subName//': '//trim(drydep_list(i))//' is not in tables' ) + end if + end if + + !--- Figure out the specific species indices --- + if ( trim(drydep_list(i)) == 'H2' ) h2_ndx = i + if ( trim(drydep_list(i)) == 'CO' ) co_ndx = i + if ( trim(drydep_list(i)) == 'CH4' ) ch4_ndx = i + if ( trim(drydep_list(i)) == 'MPAN' ) mpan_ndx = i + if ( trim(drydep_list(i)) == 'PAN' ) pan_ndx = i + if ( trim(drydep_list(i)) == 'SO2' ) so2_ndx = i + if ( trim(drydep_list(i)) == 'OX' .or. trim(drydep_list(i)) == 'O3' ) o3_ndx = i + if ( trim(drydep_list(i)) == 'O3A' ) o3a_ndx = i + if ( trim(drydep_list(i)) == 'XPAN' ) xpan_ndx = i + + if( mapping(i) > 0) then + l = mapping(i) + foxd(i) = dfoxd(l) + drat(i) = sqrt(mol_wgts(l)/wh2o) + endif + + enddo + + where( rgss < 1._r8 ) + rgss = 1._r8 + endwhere + + where( rac < small_value) + rac = small_value + endwhere + + drydep_initialized = .true. + + end subroutine seq_drydep_init + +!==================================================================================== + + subroutine set_hcoeff_scalar( sfc_temp, heff ) + + !======================================================================== + ! Interface to seq_drydep_setHCoeff when input is scalar + ! wrapper routine used when surface temperature is a scalar (single column) rather + ! than an array (multiple columns). + ! + ! !REVISION HISTORY: + ! 2008-Nov-12 - F. Vitt - first version + !======================================================================== + + implicit none + + real(r8), intent(in) :: sfc_temp ! Input surface temperature + real(r8), intent(out) :: heff(n_drydep) ! Output Henry's law coefficients + + !----- local ----- + real(r8) :: sfc_temp_tmp(1) ! surface temp + + sfc_temp_tmp(:) = sfc_temp + call set_hcoeff_vector( 1, sfc_temp_tmp, heff(:n_drydep) ) + + end subroutine set_hcoeff_scalar + +!==================================================================================== + + subroutine set_hcoeff_vector( ncol, sfc_temp, heff ) + + !======================================================================== + ! Interface to seq_drydep_setHCoeff when input is vector + ! sets dry depositions coefficients -- used by both land and atmosphere models + !======================================================================== + + integer, intent(in) :: ncol ! Input size of surface-temp vector + real(r8), intent(in) :: sfc_temp(ncol) ! Surface temperature + real(r8), intent(out) :: heff(ncol,n_drydep) ! Henry's law coefficients + + !----- local ----- + real(r8), parameter :: t0 = 298._r8 ! Standard Temperature + real(r8), parameter :: ph_inv = 1._r8/ph ! Inverse of PH + integer :: m, l, id ! indices + real(r8) :: e298 ! Henry's law coefficient @ standard temperature (298K) + real(r8) :: dhr ! temperature dependence of Henry's law coefficient + real(r8) :: dk1s(ncol) ! DK Work array 1 + real(r8) :: dk2s(ncol) ! DK Work array 2 + real(r8) :: wrk(ncol) ! Work array + + !----- formats ----- + character(*),parameter :: subName = '(seq_drydep_set_hcoeff) ' + character(*),parameter :: F00 = "('(seq_drydep_set_hcoeff) ',8a)" + + !------------------------------------------------------------------------------- + ! notes: + !------------------------------------------------------------------------------- + + wrk(:) = (t0 - sfc_temp(:))/(t0*sfc_temp(:)) + do m = 1,n_drydep + l = mapping(m) + id = 6*(l - 1) + e298 = dheff(id+1) + dhr = dheff(id+2) + heff(:,m) = e298*exp( dhr*wrk(:) ) + !--- Calculate coefficients based on the drydep tables --- + if( dheff(id+3) /= 0._r8 .and. dheff(id+5) == 0._r8 ) then + e298 = dheff(id+3) + dhr = dheff(id+4) + dk1s(:) = e298*exp( dhr*wrk(:) ) + where( heff(:,m) /= 0._r8 ) + heff(:,m) = heff(:,m)*(1._r8 + dk1s(:)*ph_inv) + elsewhere + heff(:,m) = dk1s(:)*ph_inv + endwhere + end if + !--- For coefficients that are non-zero AND CO2 or NH3 handle things this way --- + if( dheff(id+5) /= 0._r8 ) then + if( trim( drydep_list(m) ) == 'CO2' .or. trim( drydep_list(m) ) == 'NH3' & + .or. trim( drydep_list(m) ) == 'SO2' ) then + e298 = dheff(id+3) + dhr = dheff(id+4) + dk1s(:) = e298*exp( dhr*wrk(:) ) + e298 = dheff(id+5) + dhr = dheff(id+6) + dk2s(:) = e298*exp( dhr*wrk(:) ) + !--- For Carbon dioxide --- + if( trim(drydep_list(m)) == 'CO2'.or. trim( drydep_list(m) ) == 'SO2' ) then + heff(:,m) = heff(:,m)*(1._r8 + dk1s(:)*ph_inv*(1._r8 + dk2s(:)*ph_inv)) + !--- For NH3 --- + else if( trim( drydep_list(m) ) == 'NH3' ) then + heff(:,m) = heff(:,m)*(1._r8 + dk1s(:)*ph/dk2s(:)) + !--- This can't happen --- + else + write(s_logunit,F00) 'Bad species ',drydep_list(m) + call shr_sys_abort( subName//'ERROR: in assigning coefficients' ) + end if + end if + end if + end do + + end subroutine set_hcoeff_vector + +!=============================================================================== + end module seq_drydep_mod diff --git a/cesm/nuopc_cap_share/shr_fire_emis_mod.F90 b/cesm/nuopc_cap_share/shr_fire_emis_mod.F90 index 47e9cf117..5558e8848 100644 --- a/cesm/nuopc_cap_share/shr_fire_emis_mod.F90 +++ b/cesm/nuopc_cap_share/shr_fire_emis_mod.F90 @@ -115,7 +115,7 @@ subroutine shr_fire_emis_readnl( NLFileName, emis_nflds ) logical :: fire_emis_elevated = .true. integer :: i, tmp(1) character(*),parameter :: F00 = "('(shr_fire_emis_readnl) ',2a)" - character(len=*), parameter :: subname='(shr_fire_emis_readnl)' + character(len=*), parameter :: subname = '('//__FILE__//':shr_fire_emis_readnl)' !------------------------------------------------------------------ namelist /fire_emis_nl/ fire_emis_specifier, fire_emis_factors_file, fire_emis_elevated diff --git a/cesm/nuopc_cap_share/shr_megan_mod.F90 b/cesm/nuopc_cap_share/shr_megan_mod.F90 index 4273217c0..ee01d3719 100644 --- a/cesm/nuopc_cap_share/shr_megan_mod.F90 +++ b/cesm/nuopc_cap_share/shr_megan_mod.F90 @@ -128,7 +128,7 @@ subroutine shr_megan_readnl( NLFileName, megan_nflds) integer :: rc integer :: i, tmp(1) character(*), parameter :: F00 = "('(shr_megan_readnl) ',2a)" - character(len=*), parameter :: subname='(shr_megan_readnl)' + character(len=*), parameter :: subname = '('//__FILE__//':shr_megan_readnl)' !-------------------------------------------------------------- namelist /megan_emis_nl/ megan_specifier, megan_factors_file, megan_mapped_emisfctrs diff --git a/cesm/nuopc_cap_share/shr_ozone_coupling_mod.F90 b/cesm/nuopc_cap_share/shr_ozone_coupling_mod.F90 index fbd601c3c..0600b062f 100644 --- a/cesm/nuopc_cap_share/shr_ozone_coupling_mod.F90 +++ b/cesm/nuopc_cap_share/shr_ozone_coupling_mod.F90 @@ -54,7 +54,7 @@ subroutine shr_ozone_coupling_readnl(NLFilename, atm_ozone_frequency_val) integer :: mpicom character(len=*), parameter :: atm_ozone_frequency_not_present = 'NOT_PRESENT' - character(len=*), parameter :: subname = '(shr_ozone_coupling_readnl) ' + character(len=*), parameter :: subname = '('//__FILE__//':shr_ozone_coupling_readnl)' ! ------------------------------------------------------------------ namelist /ozone_coupling_nl/ atm_ozone_frequency diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index b8909947b..a410eeba5 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -2023,6 +2023,30 @@ pio blocksize for box decompositions + + integer + 0 + run_pio + env_mach_pes.xml + Task count for asyncronous IO, only valid if PIO_ASYNC_INTERFACE is True + + + + integer + 0 + run_pio + env_mach_pes.xml + Stride of tasks for asyncronous IO, only valid if PIO_ASYNC_INTERFACE is True + + + + integer + 1 + run_pio + env_mach_pes.xml + RootPE of tasks for asyncronous IO, only valid if PIO_ASYNC_INTERFACE is True + + integer -1 diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 7674eb62b..b7ab3c937 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -36,6 +36,42 @@ + + integer + pio + PELAYOUT_attributes + + IO tasks FOR ASYNC IO, only valid if ASYNCIO is true. + + + $PIO_ASYNCIO_NTASKS + + + + + integer + pio + PELAYOUT_attributes + + IO task stride FOR ASYNC IO, only valid if ASYNCIO is true. + + + $PIO_ASYNCIO_STRIDE + + + + + integer + pio + PELAYOUT_attributes + + IO rootpe task FOR ASYNC IO, only valid if ASYNCIO is true. + + + $PIO_ASYNCIO_ROOTPE + + + char expdef @@ -3987,6 +4023,7 @@ $ESMF_VERBOSITY_LEVEL + char mapping @@ -4110,7 +4147,7 @@ $ROF_PIO_REARRANGER $GLC_PIO_REARRANGER $WAV_PIO_REARRANGER - -99 + $ESP_PIO_REARRANGER diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index 36dda2519..a96fcfdd6 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -103,7 +103,7 @@ subroutine med_fldList_AddFld(flds, stdname, shortname) logical :: found integer :: mapsize, mrgsize type(med_fldList_entry_type), pointer :: newflds(:) - character(len=*), parameter :: subname='(med_fldList_AddFld)' + character(len=*), parameter :: subname = '('//__FILE__//':med_fldList_AddFld)' ! ---------------------------------------------- if (associated(flds)) then @@ -210,7 +210,7 @@ subroutine med_fldList_AddMrg(flds, fldname, mrg_from, mrg_fld, mrg_type, mrg_fr ! local variables integer :: n, id - character(len=*), parameter :: subname='(med_fldList_AddMrg)' + character(len=*), parameter :: subname = '('//__FILE__//':med_fldList_AddMrg)' ! ---------------------------------------------- id = 0 @@ -255,7 +255,7 @@ subroutine med_fldList_AddMap(flds, fldname, destcomp, maptype, mapnorm, mapfile integer :: id, n integer :: rc character(len=CX) :: lmapfile - character(len=*),parameter :: subname='(med_fldList_AddMap)' + character(len=*), parameter :: subname = '('//__FILE__//':med_fldList_AddMap)' ! ---------------------------------------------- lmapfile = 'unset' if (present(mapfile)) lmapfile = mapfile @@ -334,7 +334,7 @@ subroutine med_fldList_Realize(state, fldList, flds_scalar_name, flds_scalar_num character(ESMF_MAXSTR), pointer :: ConnectedList(:) character(ESMF_MAXSTR), pointer :: NameSpaceList(:) character(ESMF_MAXSTR), pointer :: itemNameList(:) - character(len=*),parameter :: subname='(med_fldList_Realize)' + character(len=*), parameter :: subname = '('//__FILE__//':med_fldList_Realize)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -488,7 +488,7 @@ subroutine SetScalarField(field, flds_scalar_name, flds_scalar_num, rc) ! local variables type(ESMF_Distgrid) :: distgrid type(ESMF_Grid) :: grid - character(len=*), parameter :: subname='(SetScalarField)' + character(len=*), parameter :: subname = '('//__FILE__//':SetScalarField)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -525,7 +525,7 @@ subroutine med_fldList_GetFldInfo_general(fldList, fldindex, stdname, shortname) character(len=*) , intent(out) :: shortname ! local variables - character(len=*), parameter :: subname='(med_fldList_GetFldInfo_general)' + character(len=*), parameter :: subname = '('//__FILE__//':med_fldList_GetFldInfo_general)' ! ---------------------------------------------- stdname = fldList%flds(fldindex)%stdname @@ -544,7 +544,7 @@ subroutine med_fldList_GetFldInfo_stdname(fldList, fldindex_in, stdname_out) character(len=*) , intent(out) :: stdname_out ! local variables - character(len=*), parameter :: subname='(med_fldList_GetFldInfo_stdname)' + character(len=*), parameter :: subname = '('//__FILE__//':med_fldList_GetFldInfo_stdname)' ! ---------------------------------------------- stdname_out = fldList%flds(fldindex_in)%stdname @@ -562,7 +562,7 @@ subroutine med_fldList_GetFldInfo_index(fldList, stdname_in, fldindex_out) ! local variables integer :: n - character(len=*), parameter :: subname='(med_fldList_GetFldInfo_index)' + character(len=*), parameter :: subname = '('//__FILE__//':med_fldList_GetFldInfo_index)' ! ---------------------------------------------- fldindex_out = 0 @@ -588,7 +588,7 @@ subroutine med_fldList_GetFldInfo_merging(fldList, fldindex, compsrc, merge_fiel character(len=*) , intent(out) :: merge_fracname ! local variables - character(len=*), parameter :: subname='(med_fldList_GetFldInfo_merging)' + character(len=*), parameter :: subname = '('//__FILE__//':med_fldList_GetFldInfo_merging)' ! ---------------------------------------------- merge_field = fldList%flds(fldindex)%merge_fields(compsrc) @@ -666,7 +666,7 @@ subroutine med_fldList_Document_Mapping(logunit, med_coupling_active) character(len=CL) :: mrgstr character(len=CL) :: cvalue logical :: init_mrgstr - character(len=*),parameter :: subname = '(med_fldList_Document_Mapping)' + character(len=*), parameter :: subname = '('//__FILE__//':med_fldList_Document_Mapping)' !----------------------------------------------------------- !--------------------------------------- @@ -763,7 +763,7 @@ subroutine med_fldList_Document_Merging(logunit, med_coupling_active) character(len=CS) :: string character(len=CL) :: mrgstr logical :: init_mrgstr - character(len=*),parameter :: subname = '(med_fldList_Document_Mapping)' + character(len=*), parameter :: subname = '('//__FILE__//':med_fldList_Document_Merging)' !----------------------------------------------------------- write(logunit,*) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 48ac2a2ed..ff8fc32ed 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -95,7 +95,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) character(len=CS) :: name logical :: wavice_coupling logical :: ocn2glc_coupling - character(len=*) , parameter :: subname=' (esmFldsExchange_cesm) ' + character(len=*), parameter :: subname = '('//__FILE__//':esmFldsExchange_cesm)' !-------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/esmFldsExchange_hafs_mod.F90 b/mediator/esmFldsExchange_hafs_mod.F90 index bfa23dc25..2197fc81d 100644 --- a/mediator/esmFldsExchange_hafs_mod.F90 +++ b/mediator/esmFldsExchange_hafs_mod.F90 @@ -58,7 +58,7 @@ subroutine esmFldsExchange_hafs(gcomp, phase, rc) integer , intent(inout) :: rc ! local variables: - character(len=*) , parameter :: subname='(esmFldsExchange_hafs)' + character(len=*), parameter :: subname = '('//__FILE__//':esmFldsExchange_hafs)' !-------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -106,7 +106,7 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) character(len=CS), allocatable :: S_flds(:) character(len=CS), allocatable :: F_flds(:,:) character(len=CS), allocatable :: suffix(:) - character(len=*) , parameter :: subname='(esmFldsExchange_hafs_advt)' + character(len=*), parameter :: subname = '('//__FILE__//':esmFldsExchange_hafs_advt)' !-------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -261,7 +261,7 @@ subroutine esmFldsExchange_hafs_fchk(gcomp, phase, rc) ! local variables: type(InternalState) :: is_local - character(len=*) , parameter :: subname='(esmFldsExchange_hafs_fchk)' + character(len=*), parameter :: subname = '('//__FILE__//':esmFldsExchange_hafs_fchk)' !-------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -319,7 +319,7 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) character(len=CS), allocatable :: S_flds(:) character(len=CS), allocatable :: F_flds(:,:) character(len=CS), allocatable :: suffix(:) - character(len=*) , parameter :: subname='(esmFldsExchange_hafs_init)' + character(len=*), parameter :: subname = '('//__FILE__//':esmFldsExchange_hafs_init)' !-------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -498,7 +498,7 @@ subroutine esmFldsExchange_hafs_attr(gcomp, hafs_attr, rc) integer :: verbosity, diagnostic character(len=CL) :: cvalue logical :: isPresent, isSet - character(len=*) , parameter :: subname='(esmFldsExchange_hafs_attr)' + character(len=*), parameter :: subname = '('//__FILE__//':esmFldsExchange_hafs_attr)' !-------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 9fe5b70ba..dbd34d797 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -51,7 +51,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) character(len=CL) :: cvalue character(len=CS) :: fldname character(len=CS), allocatable :: flds(:), oflds(:), aflds(:), iflds(:) - character(len=*) , parameter :: subname='(esmFldsExchange_nems)' + character(len=*), parameter :: subname = '('//__FILE__//':esmFldsExchange_nems)' !-------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med.F90 b/mediator/med.F90 index ac92f2638..176ae8b2f 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -59,7 +59,7 @@ module MED public SetServices public SetVM private InitializeP0 - private InitializeIPDv03p1 ! advertise fields + private AdvertiseFields ! advertise fields private InitializeIPDv03p3 ! realize connected Fields with transfer action "provide" private InitializeIPDv03p4 ! optionally modify the decomp/distr of transferred Grid/Mesh private InitializeIPDv03p5 ! realize all Fields with transfer action "accept" @@ -129,7 +129,7 @@ subroutine SetServices(gcomp, rc) integer, intent(out) :: rc ! local variables - character(len=*),parameter :: subname=' (SetServices) ' + character(len=*), parameter :: subname = '('//__FILE__//':SetServices)' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -161,7 +161,7 @@ subroutine SetServices(gcomp, rc) ! The valid values are: [will provide, can provide, cannot provide] call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv03p1"/), userRoutine=InitializeIPDv03p1, rc=rc) + phaseLabelList=(/"IPDv03p1"/), userRoutine=AdvertiseFields, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ @@ -568,7 +568,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) character(len=CX) :: logfile character(len=CX) :: diagfile character(len=CX) :: do_budgets - character(len=*),parameter :: subname=' (InitializeP0) ' + character(len=*), parameter :: subname = '('//__FILE__//':InitializeP0)' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -647,7 +647,7 @@ end subroutine InitializeP0 !----------------------------------------------------------------------- - subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) + subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) ! Mediator advertises its import and export Fields and sets the ! TransferOfferGeomObject Attribute. @@ -677,7 +677,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) character(len=8) :: cnum type(InternalState) :: is_local integer :: stat - character(len=*),parameter :: subname=' (Advertise Fields) ' + character(len=*), parameter :: subname = '('//__FILE__//':AdvertiseFields)' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -912,7 +912,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) if (profile_memory) call ESMF_VMLogMemInfo("Leaving "//trim(subname)) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - end subroutine InitializeIPDv03p1 + end subroutine AdvertiseFields !----------------------------------------------------------------------------- @@ -936,7 +936,7 @@ subroutine InitializeIPDv03p3(gcomp, importState, exportState, clock, rc) type(InternalState) :: is_local type(ESMF_VM) :: vm integer :: n - character(len=*),parameter :: subname=' (Realize Fields with Transfer Provide) ' + character(len=*), parameter :: subname = '('//__FILE__//':InitializeIPDv03p3)' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -997,7 +997,7 @@ subroutine InitializeIPDv03p4(gcomp, importState, exportState, clock, rc) ! local variables type(InternalState) :: is_local integer :: n1,n2 - character(len=*),parameter :: subname=' (Modify Decomp of Mesh/Grid) ' + character(len=*), parameter :: subname = '('//__FILE__//':InitializeIPDv03p4)' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1064,7 +1064,7 @@ subroutine realizeConnectedGrid(State,string,rc) integer , allocatable :: minIndexPTile(:,:), maxIndexPTile(:,:) character(ESMF_MAXSTR) , allocatable :: fieldNameList(:) type(ESMF_DistGridConnection) , allocatable :: connectionList(:) - character(len=*),parameter :: subname=' (realizeConnectedGrid) ' + character(len=*), parameter :: subname = '('//__FILE__//':realizeConnectedGrid)' !----------------------------------------------------------- ! All of the Fields that set their TransferOfferGeomObject Attribute @@ -1325,7 +1325,7 @@ subroutine InitializeIPDv03p5(gcomp, importState, exportState, clock, rc) ! local variables type(InternalState) :: is_local integer :: n1,n2 - character(len=*),parameter :: subname=' (Realize Fields with Transfer Accept) ' + character(len=*), parameter :: subname = '('//__FILE__//':InitializeIPDv03p5)' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1397,7 +1397,7 @@ subroutine completeFieldInitialization(State,rc) integer, allocatable :: ungriddedLBound(:), ungriddedUBound(:) logical :: isPresent logical :: meshcreated - character(len=*),parameter :: subname=' (Complete Field Initialization) ' + character(len=*), parameter :: subname = '('//__FILE__//':completeFieldInitialization)' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1593,7 +1593,7 @@ subroutine DataInitialize(gcomp, rc) logical,save :: first_call = .true. real(r8) :: real_nx, real_ny character(len=CX) :: msgString - character(len=*), parameter :: subname=' (Data Initialization) ' + character(len=*), parameter :: subname = '('//__FILE__//':DataInitialize)' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -2202,7 +2202,7 @@ subroutine SetRunClock(gcomp, rc) logical, save :: stopalarmcreated=.false. integer :: alarmcount - character(len=*),parameter :: subname=' (Set Run Clock) ' + character(len=*), parameter :: subname = '('//__FILE__//':SetRunClock)' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -2287,7 +2287,7 @@ subroutine med_meshinfo_create(FB, mesh_info, FBArea, rc) real(r8), allocatable :: ownedElemCoords(:) real(r8), pointer :: dataptr(:) integer :: n, dimcount, fieldcount - character(len=*),parameter :: subname=' (module_MED:med_meshinfo_create) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_meshinfo_create)' !------------------------------------------------------------------------------- rc= ESMF_SUCCESS @@ -2360,7 +2360,7 @@ subroutine med_grid_write(grid, fileName, rc) type(ESMF_ArrayBundle) :: arrayBundle integer :: tileCount logical :: isPresent - character(len=*), parameter :: subname=' (Grid Write) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_grid_write)' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 2792d0a26..b3ff0d710 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -2751,7 +2751,7 @@ subroutine add_to_budget_diag(entries, index, name) integer :: oldsize logical :: found type(budget_diag_type), pointer :: new_entries(:) - character(len=*), parameter :: subname='(add_to_budget_diag)' + character(len=*), parameter :: subname = '('//__FILE__//':add_to_budget_diag)' !---------------------------------------------------------------------- if (associated(entries)) then diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 521ba0007..98e50a2d2 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -182,7 +182,7 @@ subroutine med_fraction_init(gcomp, rc) integer :: maptype integer :: fieldCount logical, save :: first_call = .true. - character(len=*),parameter :: subname=' (med_fraction_init)' + character(len=*), parameter :: subname = '('//__FILE__//':med_fraction_init)' !--------------------------------------- call t_startf('MED:'//subname) @@ -674,7 +674,7 @@ subroutine med_fraction_set(gcomp, rc) type(ESMF_Field) :: field_dst integer :: n integer :: maptype - character(len=*),parameter :: subname=' (med_fraction_set)' + character(len=*), parameter :: subname = '('//__FILE__//':med_fraction_set)' !--------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 99baa2fe1..718064877 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -218,7 +218,7 @@ subroutine med_internalstate_init(gcomp, rc) character(len=CX) :: msgString character(len=3) :: name integer :: num_icesheets - character(len=*),parameter :: subname=' (internalstate init) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_internalstate_init)' !----------------------------------------------------------- nullify(is_local%wrap) @@ -395,7 +395,7 @@ subroutine med_internalstate_coupling(gcomp, rc) character(len=CL) :: cvalue character(len=CX) :: msgString logical :: isPresent, isSet - character(len=*),parameter :: subname=' (internalstate allowed coupling) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_internalstate_coupling)' !----------------------------------------------------------- nullify(is_local%wrap) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 3717f5cba..ecad003c1 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -109,7 +109,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun real(R8), pointer :: dataptr(:) type(ESMF_Mesh) :: mesh_src type(ESMF_Mesh) :: mesh_dst - character(len=*), parameter :: subname=' (module_med_map: RouteHandles_init) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_map_RouteHandles_initfrom_esmflds)' !----------------------------------------------------------- call t_startf('MED:'//subname) @@ -297,7 +297,7 @@ subroutine med_map_routehandles_initfrom_fieldbundle(n1, n2, FBsrc, FBdst, mapin ! local variables type(ESMF_Field) :: fldsrc type(ESMF_Field) :: flddst - character(len=*), parameter :: subname=' (module_MED_map:med_map_routehandles_initfrom_fieldbundle) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_map_routehandles_initfrom_fieldbundle)' !--------------------------------------------- rc = ESMF_SUCCESS @@ -370,7 +370,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, integer(I4), pointer :: dof(:) integer :: srcTermProcessing_Value = 0 type(ESMF_PoleMethod_Flag) :: polemethod - character(len=*), parameter :: subname=' (module_med_map: med_map_routehandles_initfrom_field) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_map_routehandles_initfrom_field)' !--------------------------------------------- lmapfile = 'unset' @@ -641,7 +641,7 @@ logical function med_map_RH_is_created_RH3d(RHs,n1,n2,mapindex,rc) ! local variables integer :: rc1, rc2 - character(len=*), parameter :: subname=' (module_MED_map:med_map_RH_is_created_RH3d) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_map_routehandles_initfrom_field)' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -666,7 +666,7 @@ logical function med_map_RH_is_created_RH1d(RHs,mapindex,rc) ! local variables integer :: rc1, rc2 logical :: mapexists - character(len=*), parameter :: subname=' (module_MED_map:med_map_RH_is_created_RH1d) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_map_routehandles_initfrom_field)' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -736,7 +736,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & character(CL), allocatable :: fieldNameList(:) character(CS) :: mapnorm_mapindex character(len=CX) :: tmpstr - character(len=*), parameter :: subname=' (module_MED_map:med_packed_field_create) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_map_packed_field_create)' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -937,7 +937,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d type(ESMF_Field) :: udst, vdst ! only used for 3d mapping of u,v real(r8), pointer :: data_norm(:) real(r8), pointer :: data_dst(:,:) - character(len=*), parameter :: subname=' (module_MED_map:med_map_field_packed) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_map_field_packed)' !----------------------------------------------------------- call t_startf('MED:'//subname) @@ -1149,7 +1149,7 @@ subroutine med_map_field_normalized(field_src, field_dst, routehandles, maptype, integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fields integer :: lsize_src integer :: lsize_dst - character(len=*), parameter :: subname=' (module_MED_map:med_map_field_normalized) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_map_field_normalized)' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -1262,7 +1262,7 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r logical :: checkflag = .false. character(len=CS) :: lfldname real(ESMF_KIND_R8), parameter :: fillValue = 9.99e20_ESMF_KIND_R8 - character(len=*), parameter :: subname='(module_MED_map:med_map_field) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_map_field)' !--------------------------------------------------- rc = ESMF_SUCCESS @@ -1365,7 +1365,7 @@ subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, rc) integer :: spatialDim real(r8), parameter :: deg2rad = shr_const_pi/180.0_R8 ! deg to rads logical :: first_time = .true. - character(len=*), parameter :: subname=' (module_MED_map:med_map_uv_cart3d) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_map_uv_cart3d)' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_merge_mod.F90 b/mediator/med_merge_mod.F90 index bd1aa4f80..a62b7c6b9 100644 --- a/mediator/med_merge_mod.F90 +++ b/mediator/med_merge_mod.F90 @@ -79,7 +79,7 @@ subroutine med_merge_auto_multi_fldbuns(coupling_active, FBOut, FBfrac, FBImp, f real(r8), pointer :: dataptr1d(:) real(r8), pointer :: dataptr2d(:,:) logical :: zero_output - character(len=*),parameter :: subname=' (module_med_merge_mod: med_merge_auto)' + character(len=*), parameter :: subname = '('//__FILE__//':med_merge_auto_multi_fldbuns)' !--------------------------------------- call t_startf('MED:'//subname) @@ -244,7 +244,7 @@ subroutine med_merge_auto_single_fldbun(compsrc, FBOut, FBfrac, FBIn, fldListTo, real(r8), pointer :: dataptr1d(:) real(r8), pointer :: dataptr2d(:,:) logical :: zero_output - character(len=*),parameter :: subname=' (module_med_merge_mod: med_merge_auto)' + character(len=*), parameter :: subname = '('//__FILE__//':med_merge_auto_single_fldbun)' !--------------------------------------- call t_startf('MED:'//subname) @@ -364,7 +364,7 @@ subroutine med_merge_auto_field(merge_type, field_out, ungriddedUBound_out, & real(R8), pointer :: dpf1(:) real(R8), pointer :: dpf2(:,:) ! intput pointers to 1d and 2d fields real(R8), pointer :: dpw1(:) ! weight pointer - character(len=*),parameter :: subname=' (med_merge_mod: med_merge_auto_field)' + character(len=*), parameter :: subname = '('//__FILE__//':med_merge_auto_field)' !--------------------------------------- rc = ESMF_SUCCESS @@ -481,7 +481,7 @@ subroutine med_merge_auto_errcheck(compsrc, fldname_out, field_out, & type(ESMF_Field) :: field_in integer :: ungriddedUBound_in(1) ! size of ungridded dimension, if any character(len=CL) :: errmsg - character(len=*),parameter :: subname=' (module_med_merge_mod: med_merge_errcheck)' + character(len=*), parameter :: subname = '('//__FILE__//':med_merge_auto_errcheck)' !--------------------------------------- rc = ESMF_SUCCESS @@ -572,7 +572,7 @@ subroutine med_merge_field_1D(FBout, fnameout, & integer :: lb1,ub1,i,j,n logical :: wgtfound, FBinfound integer :: dbrc - character(len=*),parameter :: subname='(med_merge_field_1D)' + character(len=*), parameter :: subname = '('//__FILE__//':med_merge_field_1D)' ! ---------------------------------------------- if (dbug_flag > 10) then diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index f25b024cd..a15c2d55c 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -109,7 +109,7 @@ subroutine med_methods_FB_init_pointer(StateIn, FBout, flds_scalar_name, name, r real(R8), pointer :: dataptr1d(:) real(R8), pointer :: dataptr2d(:,:) character(ESMF_MAXSTR), allocatable :: lfieldNameList(:) - character(len=*), parameter :: subname='(med_methods_FB_init_pointer)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_init_pointer)' ! ---------------------------------------------- ! Create empty FBout @@ -262,7 +262,7 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S integer, allocatable :: gridToFieldMap(:) logical :: isPresent character(ESMF_MAXSTR), allocatable :: lfieldNameList(:) - character(len=*), parameter :: subname='(med_methods_FB_init)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_init)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -540,7 +540,7 @@ subroutine med_methods_FB_getNameN(FB, fieldnum, fieldname, rc) ! local variables integer :: fieldCount character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) - character(len=*),parameter :: subname='(med_methods_FB_getNameN)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_getNameN)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -586,7 +586,7 @@ subroutine med_methods_FB_getFieldN(FB, fieldnum, field, rc) ! local variables character(len=ESMF_MAXSTR) :: name - character(len=*),parameter :: subname='(med_methods_FB_getFieldN)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_getFieldN)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -624,7 +624,7 @@ subroutine med_methods_State_getNameN(State, fieldnum, fieldname, rc) ! local variables integer :: fieldCount character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) - character(len=*),parameter :: subname='(med_methods_State_getNameN)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_State_getNameN)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -671,7 +671,7 @@ subroutine med_methods_State_getNumFields(State, fieldnum, rc) ! local variables integer :: n,itemCount type(ESMF_Field), pointer :: fieldList(:) - character(len=*),parameter :: subname='(med_methods_State_getNumFields)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_State_getNumFields)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -718,7 +718,7 @@ subroutine med_methods_FB_reset(FB, value, rc) integer :: lrank real(R8), pointer :: fldptr1(:) real(R8), pointer :: fldptr2(:,:) - character(len=*),parameter :: subname='(med_methods_FB_reset)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_reset)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -796,7 +796,7 @@ subroutine med_methods_State_reset(State, value, rc) integer :: lrank real(R8), pointer :: fldptr1(:) real(R8), pointer :: fldptr2(:,:) - character(len=*),parameter :: subname='(med_methods_State_reset)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_State_reset)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -862,7 +862,7 @@ subroutine med_methods_FB_average(FB, count, rc) real(R8), pointer :: dataPtr1(:) real(R8), pointer :: dataPtr2(:,:) type(ESMF_Field) :: lfield - character(len=*),parameter :: subname='(med_methods_FB_average)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_average)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -941,7 +941,7 @@ subroutine med_methods_FB_diagnose(FB, string, rc) real(R8), pointer :: dataPtr1d(:) real(R8), pointer :: dataPtr2d(:,:) type(ESMF_Field) :: lfield - character(len=*), parameter :: subname='(med_methods_FB_diagnose)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_diagnose)' ! ---------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1021,7 +1021,7 @@ subroutine med_methods_Array_diagnose(array, string, rc) ! local variables character(len=CS) :: lstring real(R8), pointer :: dataPtr3d(:,:,:) - character(len=*),parameter :: subname='(med_methods_Array_diagnose)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_Array_diagnose)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1075,7 +1075,7 @@ subroutine med_methods_State_diagnose(State, string, rc) real(R8), pointer :: dataPtr1d(:) real(R8), pointer :: dataPtr2d(:,:) type(ESMF_Field) :: lfield - character(len=*),parameter :: subname='(med_methods_State_diagnose)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_State_diagnose)' ! ---------------------------------------------- if (dbug_flag > 5) then @@ -1157,7 +1157,7 @@ subroutine med_methods_FB_Field_diagnose(FB, fieldname, string, rc) real(R8), pointer :: dataPtr2d(:,:) type(ESMF_Field) :: lfield integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fields - character(len=*),parameter :: subname='(med_methods_FB_Field_diagnose)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_Field_diagnose)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1222,7 +1222,7 @@ subroutine med_methods_Field_diagnose(field, fieldname, string, rc) character(len=CS) :: lstring real(R8), pointer :: dataPtr1d(:) real(R8), pointer :: dataPtr2d(:,:) - character(len=*),parameter :: subname='(med_methods_Field_diagnose)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_Field_diagnose)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1284,7 +1284,7 @@ subroutine med_methods_FB_copy(FBout, FBin, rc) type(ESMF_FieldBundle), intent(inout) :: FBout type(ESMF_FieldBundle), intent(in) :: FBin integer , intent(out) :: rc - character(len=*), parameter :: subname='(med_methods_FB_copy)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_copy)' ! ---------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1327,7 +1327,7 @@ subroutine med_methods_FB_accum(FBout, FBin, copy, rc) real(R8), pointer :: dataPtri2(:,:) real(R8), pointer :: dataPtro2(:,:) type(ESMF_Field) :: lfield - character(len=*), parameter :: subname='(med_methods_FB_accum)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_accum)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1439,7 +1439,7 @@ logical function med_methods_FB_FldChk(FB, fldname, rc) integer , intent(out) :: rc ! local variables - character(len=*), parameter :: subname='(med_methods_FB_FldChk)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_accum)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1499,7 +1499,7 @@ subroutine med_methods_Field_GetFldPtr(field, fldptr1, fldptr2, rank, abort, rc) integer :: lrank, nnodes, nelements logical :: labort type(ESMF_GeomType_Flag) :: geomtype - character(len=*), parameter :: subname='(med_methods_Field_GetFldPtr)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_Field_GetFldPtr)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1619,7 +1619,7 @@ subroutine med_methods_FB_GetFldPtr(FB, fldname, fldptr1, fldptr2, rank, field, ! local variables type(ESMF_Field) :: lfield integer :: lrank - character(len=*), parameter :: subname='(med_methods_FB_GetFldPtr)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_GetFldPtr)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1670,7 +1670,7 @@ logical function med_methods_FieldPtr_Compare1(fldptr1, fldptr2, cstring, rc) integer , intent(out) :: rc ! local variables - character(len=*), parameter :: subname='(med_methods_FieldPtr_Compare1)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_GetFldPtr)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1707,7 +1707,7 @@ logical function med_methods_FieldPtr_Compare2(fldptr1, fldptr2, cstring, rc) integer , intent(out) :: rc ! local variables - character(len=*), parameter :: subname='(med_methods_FieldPtr_Compare2)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_GetFldPtr)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1750,7 +1750,7 @@ subroutine med_methods_State_GeomPrint(state, string, rc) integer :: fieldcount character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) character(ESMF_MAXSTR) :: name - character(len=*),parameter :: subname='(med_methods_State_GeomPrint)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_State_GeomPrint)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1793,7 +1793,7 @@ subroutine med_methods_FB_GeomPrint(FB, string, rc) type(ESMF_Field) :: lfield integer :: fieldcount - character(len=*),parameter :: subname='(med_methods_FB_GeomPrint)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_FB_GeomPrint)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1836,7 +1836,7 @@ subroutine med_methods_Field_GeomPrint(field, string, rc) real(R8), pointer :: dataPtr1(:) real(R8), pointer :: dataPtr2(:,:) type(ESMF_GeomType_Flag) :: geomtype - character(len=*),parameter :: subname='(med_methods_Field_GeomPrint)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_Field_GeomPrint)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -1918,7 +1918,7 @@ subroutine med_methods_Mesh_Print(mesh, string, rc) integer, allocatable :: minIndexPTile(:,:), maxIndexPTile(:,:) type(ESMF_MeshStatus_Flag) :: meshStatus logical :: elemDGPresent, nodeDGPresent - character(len=*),parameter :: subname='(med_methods_Mesh_Print)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_Mesh_Print)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -2082,7 +2082,7 @@ subroutine med_methods_Grid_Print(grid, string, rc) real(R8), pointer :: fldptrR81D(:) real(R8), pointer :: fldptrR82D(:,:) integer :: n1,n2,n3 - character(len=*),parameter :: subname='(med_methods_Grid_Print)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_Grid_Print)' ! ---------------------------------------------- if (dbug_flag > 10) then @@ -2209,7 +2209,7 @@ subroutine med_methods_Clock_TimePrint(clock,string,rc) type(ESMF_TimeInterval) :: timeStep character(len=CS) :: timestr character(len=CL) :: lstring - character(len=*), parameter :: subname='(med_methods_Clock_TimePrint)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_Clock_TimePrint)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -2281,7 +2281,7 @@ subroutine med_methods_State_GetScalar(state, scalar_id, scalar_value, flds_scal type(ESMF_Field) :: field real(R8), pointer :: farrayptr(:,:) real(r8) :: tmp(1) - character(len=*), parameter :: subname='(med_methods_State_GetScalar)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_State_GetScalar)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -2344,7 +2344,7 @@ subroutine med_methods_State_SetScalar(scalar_value, scalar_id, State, flds_scal type(ESMF_Field) :: field type(ESMF_VM) :: vm real(R8), pointer :: farrayptr(:,:) - character(len=*), parameter :: subname='(med_methods_State_SetScalar)' + character(len=*), parameter :: subname = '('//__FILE__//':med_methods_State_SetScalar)' ! ---------------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index c0c442a7f..425919646 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -178,7 +178,7 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) integer :: n integer :: fieldcount type(InternalState) :: is_local - character(len=*),parameter :: subname=' (med_phases_aofluxes_init_fldbuns) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_aofluxes_init_fldbuns)' !--------------------------------------- ! Create field bundles for mediator ocean/atmosphere flux computation @@ -275,7 +275,7 @@ subroutine med_phases_aofluxes_run(gcomp, rc) type(aoflux_out_type) , save :: aoflux_out logical , save :: aoflux_created logical , save :: first_call = .true. - character(len=*),parameter :: subname=' (med_phases_aofluxes_run) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_aofluxes_run)' !--------------------------------------- rc = ESMF_SUCCESS @@ -505,7 +505,7 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) type(ESMF_Mesh) :: lmesh real(R8), pointer :: garea(:) => null() type(ESMF_CoordSys_Flag) :: coordSys - character(len=*),parameter :: subname=' (med_aofluxes_init_ocngrid) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_aofluxes_init_ogrid)' !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -615,7 +615,8 @@ subroutine med_aofluxes_init_agrid(gcomp, aoflux_in, aoflux_out, rc) type(ESMF_Mesh) :: lmesh real(R8), pointer :: garea(:) => null() type(ESMF_CoordSys_Flag) :: coordSys - character(len=*),parameter :: subname=' (med_aofluxes_init_atmgrid) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_aofluxes_init_agrid)' + !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -775,7 +776,7 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) type(ESMF_CoordSys_Flag) :: coordSys real(ESMF_KIND_R8) ,allocatable :: garea(:) character(ESMF_MAXSTR),allocatable :: fieldNameList(:) - character(len=*),parameter :: subname=' (med_aofluxes_init_xgrid) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_aofluxes_init_xgrid)' !----------------------------------------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 7cfc6fc89..7fed47fe4 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -181,7 +181,7 @@ subroutine med_phases_history_write(gcomp, rc) type(ESMF_TimeInterval) :: ringInterval integer :: ringInterval_length logical :: first_time = .true. - character(len=*), parameter :: subname='(med_phases_history_write)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_history_write)' !--------------------------------------- rc = ESMF_SUCCESS @@ -402,7 +402,7 @@ subroutine med_phases_history_write_med(gcomp, rc) character(CL) :: hist_n_in logical :: isPresent logical :: isSet - character(len=*), parameter :: subname='(med_phases_history_write_med)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_history_write_med)' !--------------------------------------- rc = ESMF_SUCCESS @@ -544,7 +544,7 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) character(len=CL) :: hist_file integer :: m logical :: isPresent, isSet - character(len=*), parameter :: subname='(med_phases_history_write_lnd2glc)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_history_write_lnd2glc)' !--------------------------------------- rc = ESMF_SUCCESS @@ -680,7 +680,7 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) real(r8) :: time_bnds(2) ! time bounds output logical :: write_now ! true => write to history type real(r8) :: tbnds(2) ! CF1.0 time bounds - character(len=*), parameter :: subname='(med_phases_history_write_inst_comp)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_history_write_comp_inst)' !--------------------------------------- rc = ESMF_SUCCESS @@ -839,7 +839,7 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) logical :: write_now ! true => write to history type real(r8) :: tbnds(2) ! CF1.0 time bounds character(CS) :: scalar_name - character(len=*), parameter :: subname='(med_phases_history_write_comp_avg)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_history_write_comp_avg)' !--------------------------------------- rc = ESMF_SUCCESS @@ -1059,7 +1059,7 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) real(r8) :: time_val ! time coordinate output real(r8) :: time_bnds(2) ! time bounds output character(CS), allocatable :: fieldNameList(:) - character(len=*), parameter :: subname='(med_phases_history_write_comp_aux)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_history_write_comp_aux)' !--------------------------------------- rc = ESMF_SUCCESS @@ -1531,7 +1531,7 @@ subroutine med_phases_history_init_histclock(gcomp, hclock, alarm, alarmname, hi type(ESMF_TimeInterval) :: htimestep type(ESMF_TimeInterval) :: mtimestep, dtimestep integer :: msec, dsec - character(len=*), parameter :: subname='(med_phases_history_init_histclock) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_history_init_histclock)' !--------------------------------------- rc = ESMF_SUCCESS @@ -1593,7 +1593,7 @@ subroutine med_phases_history_query_ifwrite(gcomp, hclock, alarmname, write_now, integer :: yr,mon,day,sec ! time units type(ESMF_TimeInterval) :: ringInterval integer :: ringInterval_length - character(len=*), parameter :: subname='(med_phases_history_query_ifwrite) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_history_query_ifwrite)' !--------------------------------------- rc = ESMF_SUCCESS @@ -1707,7 +1707,7 @@ subroutine med_phases_history_set_timeinfo(gcomp, hclock, alarmname, & integer :: start_ymd ! Starting date YYYYMMDD logical :: isPresent logical :: isSet - character(len=*), parameter :: subname='(med_phases_history_set_timeinfo) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_history_set_timeinfo)' !--------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 1fe8fb502..b9c38b957 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -252,7 +252,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) real(R8), parameter :: const_deg2rad = shr_const_pi/180.0_R8 ! deg to rads character(CL) :: msg logical :: first_call = .true. - character(len=*) , parameter :: subname='(med_phases_ocnalb_run)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_ocnalb_run)' !--------------------------------------- rc = ESMF_SUCCESS @@ -463,7 +463,7 @@ subroutine med_phases_ocnalb_orbital_init(gcomp, logunit, mastertask, rc) ! local variables character(len=CL) :: msgstr ! temporary character(len=CL) :: cvalue ! temporary - character(len=*) , parameter :: subname = "(med_phases_ocnalb_orbital_init)" + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_ocnalb_orbital_init)' !------------------------------------------- rc = ESMF_SUCCESS @@ -570,7 +570,7 @@ subroutine med_phases_ocnalb_orbital_update(clock, logunit, mastertask, eccen, character(len=CL) :: msgstr ! temporary logical :: lprint logical :: first_time = .true. - character(len=*) , parameter :: subname = "(med_phases_ocnalb_orbital_update)" + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_ocnalb_orbital_update)' !------------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_phases_post_atm_mod.F90 b/mediator/med_phases_post_atm_mod.F90 index ab6f65e2b..1be463731 100644 --- a/mediator/med_phases_post_atm_mod.F90 +++ b/mediator/med_phases_post_atm_mod.F90 @@ -43,7 +43,7 @@ subroutine med_phases_post_atm(gcomp, rc) ! local variables type(InternalState) :: is_local type(ESMF_Clock) :: dClock - character(len=*), parameter :: subname='(med_phases_post_atm)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_post_atm)' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_phases_post_glc_mod.F90 b/mediator/med_phases_post_glc_mod.F90 index 14610e710..e01bddf8d 100644 --- a/mediator/med_phases_post_glc_mod.F90 +++ b/mediator/med_phases_post_glc_mod.F90 @@ -98,7 +98,7 @@ subroutine med_phases_post_glc(gcomp, rc) logical :: first_call = .true. logical :: isPresent character(CL) :: cvalue - character(len=*), parameter :: subname='(med_phases_post_glc)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_post_glc)' !--------------------------------------- rc = ESMF_SUCCESS @@ -246,7 +246,7 @@ subroutine map_glc2lnd_init(gcomp, rc) integer :: fieldCount integer :: ns,n type(ESMF_Field), pointer :: fieldlist(:) - character(len=*) , parameter :: subname='(map_glc2lnd_init)' + character(len=*), parameter :: subname = '('//__FILE__//':map_glc2lnd_init)' !--------------------------------------- rc = ESMF_SUCCESS @@ -383,7 +383,7 @@ subroutine map_glc2lnd( gcomp, rc) real(r8), pointer :: dataptr1d_src(:) real(r8), pointer :: dataptr1d_dst(:) real(r8), pointer :: icemask_l(:) - character(len=*), parameter :: subname = 'map_glc2lnd' + character(len=*), parameter :: subname = '('//__FILE__//':map_glc2lnd)' !----------------------------------------------------------------------- call t_startf('MED:'//subname) diff --git a/mediator/med_phases_post_ice_mod.F90 b/mediator/med_phases_post_ice_mod.F90 index d081448e4..fc4c84dfc 100644 --- a/mediator/med_phases_post_ice_mod.F90 +++ b/mediator/med_phases_post_ice_mod.F90 @@ -40,7 +40,7 @@ subroutine med_phases_post_ice(gcomp, rc) ! local variables type(InternalState) :: is_local type(ESMF_Clock) :: dClock - character(len=*),parameter :: subname='(med_phases_post_ice)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_post_ice)' !------------------------------------------------------------------------------- call t_startf('MED:'//subname) diff --git a/mediator/med_phases_post_lnd_mod.F90 b/mediator/med_phases_post_lnd_mod.F90 index d057506af..49bd90255 100644 --- a/mediator/med_phases_post_lnd_mod.F90 +++ b/mediator/med_phases_post_lnd_mod.F90 @@ -37,7 +37,7 @@ subroutine med_phases_post_lnd(gcomp, rc) ! local variables type(InternalState) :: is_local type(ESMF_Clock) :: dClock - character(len=*),parameter :: subname='(med_phases_post_lnd)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_post_lnd)' !------------------------------------------------------------------------------- call t_startf('MED:'//subname) diff --git a/mediator/med_phases_post_ocn_mod.F90 b/mediator/med_phases_post_ocn_mod.F90 index abf766211..a883890ca 100644 --- a/mediator/med_phases_post_ocn_mod.F90 +++ b/mediator/med_phases_post_ocn_mod.F90 @@ -39,7 +39,7 @@ subroutine med_phases_post_ocn(gcomp, rc) ! local variables type(InternalState) :: is_local type(ESMF_Clock) :: dClock - character(len=*),parameter :: subname='(med_phases_post_ocn)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_post_ocn)' !--------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_phases_post_rof_mod.F90 b/mediator/med_phases_post_rof_mod.F90 index ea478b0cc..0d5999cf0 100644 --- a/mediator/med_phases_post_rof_mod.F90 +++ b/mediator/med_phases_post_rof_mod.F90 @@ -36,7 +36,7 @@ subroutine med_phases_post_rof(gcomp, rc) ! local variables type(InternalState) :: is_local type(ESMF_Clock) :: dClock - character(len=*), parameter :: subname='(med_phases_post_rof)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_post_rof)' !--------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_phases_post_wav_mod.F90 b/mediator/med_phases_post_wav_mod.F90 index 31abf004c..57d0e61ab 100644 --- a/mediator/med_phases_post_wav_mod.F90 +++ b/mediator/med_phases_post_wav_mod.F90 @@ -35,7 +35,7 @@ subroutine med_phases_post_wav(gcomp, rc) ! local variables type(InternalState) :: is_local type(ESMF_Clock) :: dClock - character(len=*),parameter :: subname='(med_phases_post_wav)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_post_wav)' !------------------------------------------------------------------------------- call t_startf('MED:'//subname) diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 8d41adbb8..9c44d9a75 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -53,7 +53,7 @@ subroutine med_phases_prep_atm(gcomp, rc) real(R8), pointer :: ifrac(:) real(R8), pointer :: ofrac(:) integer :: i, j, n, n1, ncnt - character(len=*),parameter :: subname='(med_phases_prep_atm)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_atm)' !------------------------------------------------------------------------------- call t_startf('MED:'//subname) diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index d47bbf46c..a30b0118d 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -146,7 +146,7 @@ subroutine med_phases_prep_glc_init(gcomp, rc) character(len=CS) :: glc_renormalize_smb logical :: glc_coupled_fluxes integer :: ungriddedUBound_output(1) ! currently the size must equal 1 for rank 2 fieldds - character(len=*),parameter :: subname=' (med_phases_prep_glc_init) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_glc_init)' !--------------------------------------- call t_startf('MED:'//subname) @@ -400,7 +400,7 @@ subroutine med_phases_prep_glc_accum_lnd(gcomp, rc) integer :: i,n real(r8), pointer :: data2d_in(:,:) real(r8), pointer :: data2d_out(:,:) - character(len=*),parameter :: subname=' (med_phases_prep_glc_accum) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_glc_accum_lnd)' !--------------------------------------- call t_startf('MED:'//subname) @@ -458,7 +458,7 @@ subroutine med_phases_prep_glc_accum_ocn(gcomp, rc) integer :: i,n real(r8), pointer :: data2d_in(:,:) real(r8), pointer :: data2d_out(:,:) - character(len=*),parameter :: subname=' (med_phases_prep_glc_accum) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_glc_accum_ocn)' !--------------------------------------- call t_startf('MED:'//subname) @@ -531,7 +531,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) logical :: do_avg logical :: isPresent, isSet logical :: write_histaux_l2x1yrg - character(len=*) , parameter :: subname=' (med_phases_prep_glc) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_glc_avg)' !--------------------------------------- call t_startf('MED:'//subname) @@ -771,7 +771,7 @@ subroutine med_phases_prep_glc_map_lnd2glc(gcomp, rc) character(len=3) :: cnum type(ESMF_Field), pointer :: fieldlist_lnd(:) type(ESMF_Field), pointer :: fieldlist_glc(:) - character(len=*) , parameter :: subname=' (med_phases_prep_glc_map_lnd2glc) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_glc_map_lnd2glc)' !--------------------------------------- ! Get the internal state @@ -1063,7 +1063,7 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, ns, rc) real(r8) :: ablat_renorm_factor ! ratio between global ablation on the two grids real(r8) :: effective_area ! grid cell area multiplied by min(lfrac,icemask_l). real(r8), pointer :: area_g(:) ! areas on glc grid - character(len=*), parameter :: subname=' (renormalize_smb) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_glc_renormalize_smb)' !--------------------------------------------------------------- call t_startf('MED:'//subname) diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index 0d78bbed0..4144225ae 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -59,7 +59,7 @@ subroutine med_phases_prep_ice(gcomp, rc) integer :: scalar_id real(r8) :: tmp(1) logical :: first_precip_fact_call = .true. - character(len=*),parameter :: subname='(med_phases_prep_ice)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_ice)' !--------------------------------------- call t_startf('MED:'//subname) diff --git a/mediator/med_phases_prep_lnd_mod.F90 b/mediator/med_phases_prep_lnd_mod.F90 index 81114c1bf..4c27a4c38 100644 --- a/mediator/med_phases_prep_lnd_mod.F90 +++ b/mediator/med_phases_prep_lnd_mod.F90 @@ -51,7 +51,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) logical :: first_call = .true. real(r8), pointer :: dataptr_scalar_lnd(:,:) real(r8), pointer :: dataptr_scalar_atm(:,:) - character(len=*), parameter :: subname='(med_phases_prep_lnd)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_lnd)' !--------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 35208a109..353350d73 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -51,7 +51,7 @@ subroutine med_phases_prep_ocn_init(gcomp, rc) ! local variables type(InternalState) :: is_local - character(len=*),parameter :: subname=' (med_phases_prep_ocn_init) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_ocn_init)' !--------------------------------------- rc = ESMF_SUCCESS @@ -99,7 +99,7 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) real(r8), pointer :: rofi(:), hrofi(:) real(r8), pointer :: areas(:) real(r8), allocatable :: hcorr(:) - character(len=*), parameter :: subname='(med_phases_prep_ocn_accum)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_ocn_accum)' !--------------------------------------- call t_startf('MED:'//subname) @@ -254,7 +254,7 @@ subroutine med_phases_prep_ocn_avg(gcomp, rc) ! local variables type(InternalState) :: is_local integer :: ncnt - character(len=*),parameter :: subname='(med_phases_prep_ocn_avg)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_ocn_avg)' !--------------------------------------- rc = ESMF_SUCCESS @@ -365,7 +365,7 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) integer :: lsize real(R8) :: c1,c2,c3,c4 character(len=64), allocatable :: fldnames(:) - character(len=*), parameter :: subname='(med_phases_prep_ocn_custom_cesm)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_ocn_custom_cesm)' !--------------------------------------- rc = ESMF_SUCCESS @@ -631,7 +631,7 @@ subroutine med_phases_prep_ocn_custom_nems(gcomp, rc) real(R8), pointer :: ofrac(:) integer :: lsize real(R8) , parameter :: const_lhvap = 2.501e6_R8 ! latent heat of evaporation ~ J/kg - character(len=*), parameter :: subname='(med_phases_prep_ocn_custom_nems)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_ocn_custom_nems)' !--------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index e64eea43b..008a2ae1b 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -94,7 +94,7 @@ subroutine med_phases_prep_rof_init(gcomp, rc) type(ESMF_Mesh) :: mesh_r type(ESMF_Field) :: lfield character(len=CS), allocatable :: fldnames_temp(:) - character(len=*),parameter :: subname=' (med_phases_prep_rof_init) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_rof_init)' !--------------------------------------- rc = ESMF_SUCCESS @@ -198,7 +198,7 @@ subroutine med_phases_prep_rof_accum(gcomp, rc) real(r8), pointer :: dataptr1d_accum(:) type(ESMF_Field) :: lfield type(ESMF_Field) :: lfield_accum - character(len=*), parameter :: subname='(med_phases_prep_rof_mod: med_phases_prep_rof_accum)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_rof_accum)' !--------------------------------------- call t_startf('MED:'//subname) @@ -281,7 +281,7 @@ subroutine med_phases_prep_rof(gcomp, rc) type(ESMF_Field) :: lfield_dst type(ESMF_Field) :: field_lfrac_lnd character(CL), pointer :: lfieldnamelist(:) - character(len=*),parameter :: subname='(med_phases_prep_rof_mod: med_phases_prep_rof)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_rof)' !--------------------------------------- call t_startf('MED:'//subname) @@ -462,7 +462,7 @@ subroutine med_phases_prep_rof_irrig(gcomp, rc) real(r8), pointer :: irrig_volr0_r(:) real(r8), pointer :: irrig_flux_l(:) real(r8), pointer :: irrig_flux_r(:) - character(len=*), parameter :: subname='(med_phases_prep_rof_mod: med_phases_prep_rof_irrig)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_rof_irrig)' !--------------------------------------------------------------- call t_startf('MED:'//subname) diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index a1bd85c1b..29eeecc32 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -46,7 +46,7 @@ subroutine med_phases_prep_wav_init(gcomp, rc) ! local variables type(InternalState) :: is_local - character(len=*),parameter :: subname=' (med_phases_prep_wav_init) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_wav_init)' !--------------------------------------- rc = ESMF_SUCCESS @@ -82,7 +82,7 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) ! local variables type(InternalState) :: is_local integer :: n, ncnt - character(len=*), parameter :: subname='(med_phases_prep_wav_accum)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_wav_accum)' !--------------------------------------- call t_startf('MED:'//subname) @@ -138,7 +138,7 @@ subroutine med_phases_prep_wav_avg(gcomp, rc) ! local variables type(InternalState) :: is_local integer :: ncnt - character(len=*),parameter :: subname='(med_phases_prep_wav_avg)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_prep_wav_avg)' !--------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_phases_profile_mod.F90 b/mediator/med_phases_profile_mod.F90 index 46d8f2a73..9876127ed 100644 --- a/mediator/med_phases_profile_mod.F90 +++ b/mediator/med_phases_profile_mod.F90 @@ -65,7 +65,7 @@ subroutine med_phases_profile(gcomp, rc) real(r8) :: msize, mrss, ringdays real(r8), save :: avgdt character(len=CL) :: walltimestr, nexttimestr - character(len=*), parameter :: subname='(med_phases_profile)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_profile)' !--------------------------------------- call t_startf('MED:'//subname) diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index 5affb149a..27bead2d8 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -66,7 +66,7 @@ subroutine med_phases_restart_alarm_init(gcomp, rc) integer :: restart_n ! freq_n setting relative to freq_option logical :: isPresent logical :: isSet - character(len=*), parameter :: subname='(med_phases_restart_alarm_init)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_restart_alarm_init)' !--------------------------------------- rc = ESMF_SUCCESS @@ -182,7 +182,7 @@ subroutine med_phases_restart_write(gcomp, rc) character(ESMF_MAXSTR) :: tmpstr logical :: isPresent logical :: first_time = .true. - character(len=*), parameter :: subname='(med_phases_restart_write)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_restart_write)' !--------------------------------------- call t_startf('MED:'//subname) @@ -503,7 +503,7 @@ subroutine med_phases_restart_read(gcomp, rc) character(ESMF_MAXSTR) :: restart_pfile ! Local path to restart pointer filename character(ESMF_MAXSTR) :: cpl_inst_tag ! instance tag logical :: isPresent - character(len=*), parameter :: subname='(med_phases_restart_read)' + character(len=*), parameter :: subname = '('//__FILE__//':med_phases_restart_read)' !--------------------------------------- call t_startf('MED:'//subname) call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) diff --git a/mediator/med_time_mod.F90 b/mediator/med_time_mod.F90 index 14cd7464b..5bb15b574 100644 --- a/mediator/med_time_mod.F90 +++ b/mediator/med_time_mod.F90 @@ -87,7 +87,7 @@ subroutine med_time_alarmInit( clock, alarm, option, & type(ESMF_Time) :: NextAlarm ! Next alarm time type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval integer :: sec - character(len=*), parameter :: subname = '(med_time_alarmInit): ' + character(len=*), parameter :: subname = '('//__FILE__//':med_time_alarmInit)' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS