diff --git a/Makefile.am b/Makefile.am index da93374..ff31eec 100644 --- a/Makefile.am +++ b/Makefile.am @@ -43,6 +43,7 @@ CPPFLAGS += -I$(ATM_PREFIX)/Main -I$(ATM_PREFIX)/Main/mpplib \ libatm_a_LIBADD = $(wildcard $(ATM_PREFIX)/Main/*.o) \ $(wildcard $(ATM_PREFIX)/Main/*/*.o) \ $(wildcard $(ATM_PREFIX)/Main/*/*/*.o) \ + $(wildcard $(ATM_PREFIX)/frame/*.o) \ $(wildcard $(ATM_PREFIX)/Share/*.o) endif if DO_COMPILE_WRF @@ -53,6 +54,9 @@ CPPFLAGS += -I$(ATM_PREFIX)/Registry \ -I$(ATM_PREFIX)/external/esmf_time_f90 \ -I$(ATM_PREFIX)/main \ -I$(ATM_PREFIX)/share +if WRF_PNETCDF_SUPPORT +CPPFLAGS += -I$(ATM_PREFIX)/external/io_pnetcdf +endif libatm_a_LIBADD = $(wildcard $(ATM_PREFIX)/external/RSL_LITE/*.o) \ $(wildcard $(ATM_PREFIX)/external/io_netcdf/*.o) \ $(wildcard $(ATM_PREFIX)/external/io_grib1/*.o) \ @@ -66,6 +70,9 @@ libatm_a_LIBADD = $(wildcard $(ATM_PREFIX)/external/RSL_LITE/*.o) \ $(wildcard $(ATM_PREFIX)/frame/*.o) \ $(wildcard $(ATM_PREFIX)/dyn_em/*.o) \ $(ATM_PREFIX)/main/module_wrf_top.o +if WRF_PNETCDF_SUPPORT +libatm_a_LIBADD += $(wildcard $(ATM_PREFIX)/external/io_pnetcdf/*.o) +endif endif endif @@ -194,7 +201,7 @@ else regesm_x_SOURCES += mod_esmf_cop_void.F90 endif -FCLD = $(MPIFC) +FCLD = $(MPIFC) -qopenmp %.o: %.f90 $(FC) $(CPPFLAGS) $(FCFLAGS) -c $< diff --git a/configure.ac b/configure.ac index 3b1b38f..df41ea0 100644 --- a/configure.ac +++ b/configure.ac @@ -77,6 +77,15 @@ fi AM_CONDITIONAL(DO_COMPILE_RCM, [test x"$NO_RCM_SUPPORT" = x0]) AM_CONDITIONAL(DO_COMPILE_WRF, [test x"$NO_WRF_SUPPORT" = x0]) +# check parallel I/O for WRF +if eval "test x$DO_COMPILE_WRF != x0"; then + WRF_PNETCDF_SUPPORT=0 + AC_CHECK_FILE([$ATM_PREFIX/external/io_pnetcdf/wrf_io.o], + [WRF_PNETCDF_SUPPORT=1; AC_MSG_NOTICE([compiling WRF with pnetcdf support])]) +fi + +AM_CONDITIONAL(WRF_PNETCDF_SUPPORT, [test x"$WRF_PNETCDF_SUPPORT" = x1]) + # check OCN AC_ARG_WITH([ocn], AC_HELP_STRING([--with-ocn], diff --git a/mod_esmf_atm_rcm.F90 b/mod_esmf_atm_rcm.F90 index 9cf23d2..d07d106 100644 --- a/mod_esmf_atm_rcm.F90 +++ b/mod_esmf_atm_rcm.F90 @@ -1,9 +1,22 @@ -!======================================================================= -! Regional Earth System Model (RegESM) -! Copyright (c) 2013-2019 Ufuk Turuncoglu -! Licensed under the MIT License. -!======================================================================= -#define FILENAME "mod_esmf_atm_rcm.F90" +!----------------------------------------------------------------------- +! +! This file is part of ITU RegESM. +! +! ITU RegESM is free software: you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! ITU RegESM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with ITU RegESM. If not, see . +! +!----------------------------------------------------------------------- +#define FILENAME "mod_esmf_atm.F90" ! !----------------------------------------------------------------------- ! ATM gridded component code @@ -17,12 +30,11 @@ module mod_esmf_atm ! use ESMF use NUOPC - use NUOPC_Model, & + use NUOPC_Model, only : & NUOPC_SetServices => SetServices, & NUOPC_Label_Advance => label_Advance, & NUOPC_Label_DataInitialize => label_DataInitialize, & - NUOPC_Label_SetClock => label_SetClock, & - NUOPC_Label_CheckImport => label_CheckImport + NUOPC_Label_SetClock => label_SetClock ! use mod_types use mod_shared @@ -98,13 +110,6 @@ subroutine ATM_SetServices(gcomp, rc) specRoutine=ATM_SetClock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME)) return -! - call NUOPC_CompSpecialize(gcomp, & - specLabel=NUOPC_Label_CheckImport, & - specPhaseLabel="RunPhase1", & - specRoutine=ATM_CheckImport, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return ! call NUOPC_CompSpecialize(gcomp, specLabel=NUOPC_Label_Advance, & specRoutine=ATM_ModelAdvance, rc=rc) @@ -229,29 +234,17 @@ subroutine ATM_SetInitializeP2(gcomp, importState, exportState, & ! Set-up grid and load coordinate data !----------------------------------------------------------------------- ! - call ATM_SetGridArrays2d(gcomp, localPet, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! - if (models(Icopro)%modActive) then - call ATM_SetGridArrays3d(gcomp, localPet, rc) + call ATM_SetGridArrays(gcomp, localPet, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME)) return - end if ! !----------------------------------------------------------------------- ! Set-up fields and register to import/export states !----------------------------------------------------------------------- ! - call ATM_SetStates2d(gcomp, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! - if (models(Icopro)%modActive) then - call ATM_SetStates3d(gcomp, rc) + call ATM_SetStates(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME)) return - end if ! end subroutine ATM_SetInitializeP2 ! @@ -551,10 +544,8 @@ subroutine ATM_SetClock(gcomp, rc) ! Modify component clock time step !----------------------------------------------------------------------- ! - fac1 = maxval(connectors(Iatmos,:)%divDT, & - mask=models(:)%modActive) - fac2 = maxval(connectors(:,Iatmos)%divDT, & - mask=models(:)%modActive) + fac1 = maxval(connectors(Iatmos,:)%divDT,mask=models(:)%modActive) + fac2 = maxval(connectors(:,Iatmos)%divDT,mask=models(:)%modActive) maxdiv = max(fac1, fac2) ! call ESMF_ClockSet(cmpClock, name='atm_clock', & @@ -564,158 +555,7 @@ subroutine ATM_SetClock(gcomp, rc) ! end subroutine ATM_SetClock ! - subroutine ATM_CheckImport(gcomp, rc) - implicit none -! -!----------------------------------------------------------------------- -! Imported variable declarations -!----------------------------------------------------------------------- -! - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc -! -!----------------------------------------------------------------------- -! Local variable declarations -!----------------------------------------------------------------------- -! - integer :: i, itemCount, localPet, div, rsec - logical :: atCorrectTime - character(ESMF_MAXSTR), allocatable :: itemNameList(:) -! - type(ESMF_VM) :: vm - type(ESMF_Time) :: currTimeCmp, currTimeDrv - type(ESMF_Time) :: strTimeCmp - type(ESMF_TimeInterval) :: timeStepCmp, timeStepDrv - type(ESMF_Clock) :: modelClock, driverClock - type(ESMF_Field) :: field - type(ESMF_State) :: importState -! - rc = ESMF_SUCCESS -! -!----------------------------------------------------------------------- -! Query component -!----------------------------------------------------------------------- -! - call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! - call ESMF_VMGet(vm, localPet=localPet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! -!----------------------------------------------------------------------- -! Query driver and model clocks -!----------------------------------------------------------------------- -! - call NUOPC_ModelGet(gcomp, driverClock=driverClock, & - modelClock=modelClock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! -!----------------------------------------------------------------------- -! Get current time and time step out of the clock -!----------------------------------------------------------------------- -! - call ESMF_ClockGet(driverClock, currTime=currTimeDrv, & - timeStep=timeStepDrv, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! - call ESMF_ClockGet(modelClock, currTime=currTimeCmp, & - startTime=strTimeCmp, timeStep=timeStepCmp, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! -!----------------------------------------------------------------------- -! Check import field or not? -!----------------------------------------------------------------------- -! - div = maxval(connectors(:,Iatmos)%divDT, mask=models(:)%modActive) -! - call ESMF_TimeIntervalGet(mod((currTimeCmp-strTimeCmp), & - esmTimeStep/div), & - s=rsec, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! - if (rsec == 0) then -! -!----------------------------------------------------------------------- -! Query component for its clock and importState -!----------------------------------------------------------------------- -! - call ESMF_GridCompGet(gcomp, importState=importState, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! -!----------------------------------------------------------------------- -! Get list of import fields -!----------------------------------------------------------------------- -! - call ESMF_StateGet(importState, itemCount=itemCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! - if (.not. allocated(itemNameList)) then - allocate(itemNameList(itemCount)) - end if -! - call ESMF_StateGet(importState, itemNameList=itemNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! -!----------------------------------------------------------------------- -! Check fields in the importState -!----------------------------------------------------------------------- -! - if (itemCount > 0) then -! - do i = 1, itemCount -! - call ESMF_StateGet(importState, itemName=trim(itemNameList(i)), & - field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! - if (cplType == 1) then - atCorrectTime = NUOPC_IsAtTime(field, currTimeCmp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! - call print_timestamp(field, currTimeCmp, localPet, "ATM", rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return - else - atCorrectTime = NUOPC_IsAtTime(field, currTimeCmp+timeStepCmp, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! - call print_timestamp(field, currTimeCmp+timeStepCmp, & - localPet, "ATM", rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return - end if -! - if (.not. atCorrectTime) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg="NUOPC INCOMPATIBILITY DETECTED: "// & - "Import Fields not at correct time", & - line=__LINE__, file=FILENAME, & - rcToReturn=rc) - return - end if -! - end do - end if -! - end if -! - end subroutine ATM_CheckImport -! - subroutine ATM_SetGridArrays2d(gcomp, localPet, rc) + subroutine ATM_SetGridArrays(gcomp, localPet, rc) ! !----------------------------------------------------------------------- ! Used module declarations @@ -797,7 +637,7 @@ subroutine ATM_SetGridArrays2d(gcomp, localPet, rc) line=__LINE__, file=FILENAME)) return ! !----------------------------------------------------------------------- -! Define type of stenciles used by grid (dot and cross points) +! Define component grid (dot and cross points) !----------------------------------------------------------------------- ! if (.not. allocated(models(Iatmos)%mesh)) then @@ -819,13 +659,13 @@ subroutine ATM_SetGridArrays2d(gcomp, localPet, rc) end if ! !----------------------------------------------------------------------- -! Create grid (2d) +! Create ESMF Grid !----------------------------------------------------------------------- ! if (i == 1) then models(Iatmos)%grid = ESMF_GridCreate(distgrid=distGrid, & indexflag=ESMF_INDEX_GLOBAL,& - name="atm_grid2d", & + name="atm_grid", & rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME)) return @@ -954,663 +794,100 @@ subroutine ATM_SetGridArrays2d(gcomp, localPet, rc) end do end do ! - if (ma%has_bdyright) then - ptrX(:,jde2+1) = ptrX(:,jde2)+(ptrX(:,jde2)-ptrX(:,jde2-1)) - ptrY(:,jde2+1) = ptrY(:,jde2)+(ptrY(:,jde2)-ptrY(:,jde2-1)) - end if -! - if (ma%has_bdytop) then - ptrX(ide2+1,:) = ptrX(ide2,:)+(ptrX(ide2,:)-ptrX(ide2-1,:)) - ptrY(ide2+1,:) = ptrY(ide2,:)+(ptrY(ide2,:)-ptrY(ide2-1,:)) - end if -! - ptrA = dxsq - else if (models(Iatmos)%mesh(i)%gtype == Icross) then - if (debugLevel > 0) then - write(*,30) localPet, j, adjustl("DAT/ATM/GRD/"//name), & - ice1, ice2, jce1, jce2, & - ma%has_bdybottom, ma%has_bdyright, & - ma%has_bdytop, ma%has_bdyleft - end if -! - do i0 = ice1, ice2 - do j0 = jce1, jce2 - ptrX(i0,j0) = mddom%xlon(j0,i0) - ptrY(i0,j0) = mddom%xlat(j0,i0) - ptrM(i0,j0) = int(mddom%mask(j0,i0)) - end do - end do -! - ptrA = dxsq -! - if (ma%has_bdyright) then - ptrX(:,jce2+1) = ptrX(:,jce2)+(ptrX(:,jce2)-ptrX(:,jce2-1)) - ptrY(:,jce2+1) = ptrY(:,jce2)+(ptrY(:,jce2)-ptrY(:,jce2-1)) - end if -! - if (ma%has_bdytop) then - ptrX(ice2+1,:) = ptrX(ice2,:)+(ptrX(ice2,:)-ptrX(ice2-1,:)) - ptrY(ice2+1,:) = ptrY(ice2,:)+(ptrY(ice2,:)-ptrY(ice2-1,:)) - end if - end if -! -!----------------------------------------------------------------------- -! Nullify pointer to make sure that it does not point on a random -! part in the memory -!----------------------------------------------------------------------- -! - if (associated(ptrY)) then - nullify(ptrY) - end if - if (associated(ptrX)) then - nullify(ptrX) - end if - if (associated(ptrM)) then - nullify(ptrM) - end if - if (associated(ptrA)) then - nullify(ptrA) - end if -! - end do -! -!----------------------------------------------------------------------- -! Assign grid to gridded component -!----------------------------------------------------------------------- -! - call ESMF_GridCompSet(gcomp, grid=models(Iatmos)%grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return - if (models(Icopro)%modActive) then - end if - -! -!----------------------------------------------------------------------- -! Debug: write out component grid in VTK format -!----------------------------------------------------------------------- -! - if (debugLevel > 1) then - call ESMF_GridWriteVTK(models(Iatmos)%grid, & - filename="atmos_"// & - trim(GRIDDES(models(Iatmos)%mesh(i)%gtype))// & - "point", & - staggerLoc=staggerLoc, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return - end if - end do -! -!----------------------------------------------------------------------- -! Format definition -!----------------------------------------------------------------------- -! - 30 format(" PET(",I3.3,") - DE(",I2.2,") - ",A20," : ", & - 4I8," ",L," ",L," ",L," ",L) -! - end subroutine ATM_SetGridArrays2d -! - subroutine ATM_SetGridArrays3d(gcomp, localPet, rc) -! -!----------------------------------------------------------------------- -! Used module declarations -!----------------------------------------------------------------------- -! - use mod_mppparam, only : ma - use mod_atm_interface, only : mddom - use mod_dynparam, only : iy, jx, nproc - use mod_dynparam, only : ide1, ide2, jde1, jde2 - use mod_dynparam, only : ice1, ice2, jce1, jce2 -! - implicit none -! -!----------------------------------------------------------------------- -! Imported variable declarations -!----------------------------------------------------------------------- -! - type(ESMF_GridComp), intent(inout) :: gcomp - integer :: localPet - integer :: rc -! -!----------------------------------------------------------------------- -! Local variable declarations -!----------------------------------------------------------------------- -! - integer :: i, j, ii, jj, i0, j0, k0, kz, localDECount - integer :: cpus_per_dim(3) -! - type(ESMF_DistGrid) :: distGrid - type(ESMF_StaggerLoc) :: staggerLoc - real(ESMF_KIND_R8), pointer :: ptrX(:,:,:) - real(ESMF_KIND_R8), pointer :: ptrY(:,:,:) - real(ESMF_KIND_R8), pointer :: ptrZ(:,:,:) - character (len=40) :: name -! - rc = ESMF_SUCCESS -! -!----------------------------------------------------------------------- -! Calculate number of CPUs in each direction -!----------------------------------------------------------------------- -! - if ( nproc < 4 ) then - cpus_per_dim(2) = 1 - cpus_per_dim(1) = nproc - else if ( nproc >= 4 ) then - cpus_per_dim(2) = (nint(sqrt(dble(nproc)))/2)*2 - if ( iy > int(1.5*dble(jx)) ) then - cpus_per_dim(2) = cpus_per_dim(2) - 1 - do while ( mod(nproc,cpus_per_dim(2)) /= 0 ) - cpus_per_dim(2) = cpus_per_dim(2) - 1 - end do - else if ( jx > int(1.5*dble(iy)) ) then - cpus_per_dim(2) = cpus_per_dim(2) + 1 - do while ( mod(nproc,cpus_per_dim(2)) /= 0 ) - cpus_per_dim(2) = cpus_per_dim(2) + 1 - end do - else - do while ( mod(nproc,cpus_per_dim(2)) /= 0 ) - cpus_per_dim(2) = cpus_per_dim(2) + 1 - end do - end if - cpus_per_dim(1) = nproc/cpus_per_dim(2) - end if -! -!----------------------------------------------------------------------- -! Create DistGrid based on model domain decomposition -! -! ESMF is basically using a right handed coordinate system, and -! using the Fortran way of using the smallest stride to the first -! dimension but RegCM not. The order of dimension is reversed -! because of this limitation. -!----------------------------------------------------------------------- -! - kz = models(Iatmos)%nLevs - cpus_per_dim(3) = 1 -! - distGrid = ESMF_DistGridCreate(minIndex=(/ 1, 1, 1 /), & - maxIndex=(/ iy, jx, kz /), & - regDecomp=cpus_per_dim, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! -!----------------------------------------------------------------------- -! Define component grid (dot and cross points) -!----------------------------------------------------------------------- -! - do i = 1, 2 -! -!----------------------------------------------------------------------- -! Set staggering type -!----------------------------------------------------------------------- -! - if (models(Iatmos)%mesh(i)%gtype == Icross) then - staggerLoc = ESMF_STAGGERLOC_CENTER - else if (models(Iatmos)%mesh(i)%gtype == Idot) then - staggerLoc = ESMF_STAGGERLOC_CORNER - end if -! -!----------------------------------------------------------------------- -! Create ESMF Grid -!----------------------------------------------------------------------- -! - if (i == 1) then - models(Iatmos)%grid3d = ESMF_GridCreate(distgrid=distGrid, & - indexflag=ESMF_INDEX_GLOBAL,& - name="atm_grid3d", & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return - end if -! -!----------------------------------------------------------------------- -! Allocate coordinates -!----------------------------------------------------------------------- -! - call ESMF_GridAddCoord(models(Iatmos)%grid3d, & - staggerLoc=staggerLoc, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! -!----------------------------------------------------------------------- -! Get number of local DEs -!----------------------------------------------------------------------- -! - call ESMF_GridGet(models(Iatmos)%grid3d, & - localDECount=localDECount, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! -!----------------------------------------------------------------------- -! Get pointers and set coordinates for the grid -!----------------------------------------------------------------------- -! - do j = 0, localDECount-1 - call ESMF_GridGetCoord(models(Iatmos)%grid3d, & - localDE=j, & - staggerLoc=staggerLoc, & - coordDim=1, & - farrayPtr=ptrX, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! - call ESMF_GridGetCoord(models(Iatmos)%grid3d, & - localDE=j, & - staggerLoc=staggerLoc, & - coordDim=2, & - farrayPtr=ptrY, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! - call ESMF_GridGetCoord(models(Iatmos)%grid3d, & - localDE=j, & - staggerLoc=staggerLoc, & - coordDim=3, & - farrayPtr=ptrZ, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! -!----------------------------------------------------------------------- -! Debug: write size of pointers -!----------------------------------------------------------------------- -! - name = GRIDDES(models(Iatmos)%mesh(i)%gtype) -! - if (debugLevel > 0) then - write(*,110) localPet, j, adjustl("PTR/ATM/GRD3D/"//name), & - lbound(ptrX, dim=1), ubound(ptrX, dim=1), & - lbound(ptrX, dim=2), ubound(ptrX, dim=2), & - lbound(ptrX, dim=3), ubound(ptrX, dim=3), & - ma%has_bdybottom, ma%has_bdyright, & - ma%has_bdytop, ma%has_bdyleft - end if -! -!----------------------------------------------------------------------- -! Fill the pointers -!----------------------------------------------------------------------- -! - if (models(Iatmos)%mesh(i)%gtype == Idot) then - if (debugLevel > 0) then - write(*,110) localPet, j, adjustl("DAT/ATM/GRD3D/"//name), & - ide1, ide2, jde1, jde2, 1, kz, & - ma%has_bdybottom, ma%has_bdyright, & - ma%has_bdytop, ma%has_bdyleft - end if -! - do k0 = 1 , kz - do i0 = ide1, ide2 - do j0 = jde1, jde2 - ptrX(i0,j0,k0) = mddom%dlon(j0,i0) - ptrY(i0,j0,k0) = mddom%dlat(j0,i0) - ptrZ(i0,j0,k0) = models(Iatmos)%levs(k0) - end do - end do - end do -! - if (ma%has_bdyright) then - do k0 = 1 , kz - ptrX(:,jde2+1,k0) = ptrX(:,jde2,k0)+(ptrX(:,jde2,k0)- & - ptrX(:,jde2-1,k0)) - ptrY(:,jde2+1,k0) = ptrY(:,jde2,k0)+(ptrY(:,jde2,k0)- & - ptrY(:,jde2-1,k0)) - ptrZ(:,jde2+1,k0) = models(Iatmos)%levs(k0) - end do - end if -! - if (ma%has_bdytop) then - do k0 = 1 , kz - ptrX(ide2+1,:,k0) = ptrX(ide2,:,k0)+(ptrX(ide2,:,k0)- & - ptrX(ide2-1,:,k0)) - ptrY(ide2+1,:,k0) = ptrY(ide2,:,k0)+(ptrY(ide2,:,k0)- & - ptrY(ide2-1,:,k0)) - ptrZ(ide2+1,:,k0) = models(Iatmos)%levs(k0) - end do - end if - else if (models(Iatmos)%mesh(i)%gtype == Icross) then - if (debugLevel > 0) then - write(*,110) localPet, j, adjustl("DAT/ATM/GRD3D/"//name), & - ice1, ice2, jce1, jce2, 1, kz, & - ma%has_bdybottom, ma%has_bdyright, & - ma%has_bdytop, ma%has_bdyleft - end if -! - do k0 = 1 , kz - do i0 = ice1, ice2 - do j0 = jce1, jce2 - ptrX(i0,j0,k0) = mddom%xlon(j0,i0) - ptrY(i0,j0,k0) = mddom%xlat(j0,i0) - ptrZ(i0,j0,k0) = models(Iatmos)%levs(k0) - end do - end do - end do -! - if (ma%has_bdyright) then - do k0 = 1 , kz - ptrX(:,jce2+1,k0) = ptrX(:,jce2,k0)+(ptrX(:,jce2,k0)- & - ptrX(:,jce2-1,k0)) - ptrY(:,jce2+1,k0) = ptrY(:,jce2,k0)+(ptrY(:,jce2,k0)- & - ptrY(:,jce2-1,k0)) - ptrZ(:,jce2+1,k0) = models(Iatmos)%levs(k0) - end do - end if -! - if (ma%has_bdytop) then - do k0 = 1 , kz - ptrX(ice2+1,:,k0) = ptrX(ice2,:,k0)+(ptrX(ice2,:,k0)- & - ptrX(ice2-1,:,k0)) - ptrY(ice2+1,:,k0) = ptrY(ice2,:,k0)+(ptrY(ice2,:,k0)- & - ptrY(ice2-1,:,k0)) - ptrZ(ice2+1,:,k0) = models(Iatmos)%levs(k0) - end do - end if - end if -! -!----------------------------------------------------------------------- -! Nullify pointer to make sure that it does not point on a random -! part in the memory -!----------------------------------------------------------------------- -! - if (associated(ptrY)) then - nullify(ptrY) - end if - if (associated(ptrX)) then - nullify(ptrX) - end if - if (associated(ptrZ)) then - nullify(ptrZ) - end if -! - end do -! -!----------------------------------------------------------------------- -! Debug: write out component grid in VTK format -!----------------------------------------------------------------------- -! - if (debugLevel > 1) then - call ESMF_GridWriteVTK(models(Iatmos)%grid3d, & - filename="atmos_"// & - trim(GRIDDES(models(Iatmos)%mesh(i)%gtype))// & - "point_3d", & - staggerLoc=staggerLoc, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return - end if - end do -! -!----------------------------------------------------------------------- -! Format definition -!----------------------------------------------------------------------- -! - 110 format(" PET(",I3.3,") - DE(",I2.2,") - ",A20," : ", & - 6I8," ",L," ",L," ",L," ",L) -! - end subroutine ATM_SetGridArrays3d -! - subroutine ATM_SetStates2d(gcomp, rc) - implicit none -! -!----------------------------------------------------------------------- -! Imported variable declarations -!----------------------------------------------------------------------- -! - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc -! -!----------------------------------------------------------------------- -! Local variable declarations -!----------------------------------------------------------------------- -! - integer :: i, j, k, localPet, petCount, itemCount, localDECount - real*8, dimension(:,:), pointer :: ptr - character(ESMF_MAXSTR), allocatable :: itemNameList(:) -! - type(ESMF_VM) :: vm - type(ESMF_Field) :: field - type(ESMF_ArraySpec) :: arraySpec - type(ESMF_StaggerLoc) :: staggerLoc - type(ESMF_State) :: importState, exportState -! - rc = ESMF_SUCCESS -! -!----------------------------------------------------------------------- -! Get gridded component -!----------------------------------------------------------------------- -! - call ESMF_GridCompGet(gcomp, importState=importState, & - exportState=exportState, vm=vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! - call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! -!----------------------------------------------------------------------- -! Set array descriptor -!----------------------------------------------------------------------- -! - call ESMF_ArraySpecSet(arraySpec, typekind=ESMF_TYPEKIND_R8, & - rank=2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! -!----------------------------------------------------------------------- -! Get number of local DEs -!----------------------------------------------------------------------- -! - call ESMF_GridGet(models(Iatmos)%grid, & - localDECount=localDECount, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! -!----------------------------------------------------------------------- -! Get list of export fields -!----------------------------------------------------------------------- -! - call ESMF_StateGet(exportState, itemCount=itemCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! - if (.not. allocated(itemNameList)) then - allocate(itemNameList(itemCount)) - end if - call ESMF_StateGet(exportState, itemNameList=itemNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! -!----------------------------------------------------------------------- -! Create export fields -!----------------------------------------------------------------------- -! - do i = 1, itemCount - k = get_varid(models(Iatmos)%exportField, trim(itemNameList(i))) -! -!----------------------------------------------------------------------- -! Check rank of the export field -!----------------------------------------------------------------------- -! - if (models(Iatmos)%exportField(k)%rank .eq. 2) then -! -!----------------------------------------------------------------------- -! Set staggering type -!----------------------------------------------------------------------- -! - if (models(Iatmos)%exportField(k)%gtype == Icross) then - staggerLoc = ESMF_STAGGERLOC_CENTER - else if (models(Iatmos)%exportField(k)%gtype == Idot) then - staggerLoc = ESMF_STAGGERLOC_CORNER - end if -! -!----------------------------------------------------------------------- -! Create field -!----------------------------------------------------------------------- -! - field = ESMF_FieldCreate(models(Iatmos)%grid, & - arraySpec, & - staggerloc=staggerLoc, & - name=trim(itemNameList(i)), & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! -!----------------------------------------------------------------------- -! Put data into state -!----------------------------------------------------------------------- -! - do j = 0, localDECount-1 -! -!----------------------------------------------------------------------- -! Get pointer from field -!----------------------------------------------------------------------- -! - call ESMF_FieldGet(field, localDe=j, farrayPtr=ptr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! -!----------------------------------------------------------------------- -! Initialize pointer -!----------------------------------------------------------------------- -! - ptr = MISSING_R8 -! -!----------------------------------------------------------------------- -! Nullify pointer to make sure that it does not point on a random -! part in the memory -!----------------------------------------------------------------------- -! - if (associated(ptr)) then - nullify(ptr) - end if -! - end do -! -!----------------------------------------------------------------------- -! Add field export state -!----------------------------------------------------------------------- -! - call NUOPC_Realize(exportState, field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! - end if -! - end do -! -!----------------------------------------------------------------------- -! Deallocate arrays -!----------------------------------------------------------------------- -! - if (allocated(itemNameList)) deallocate(itemNameList) -! -!----------------------------------------------------------------------- -! Get list of import fields -!----------------------------------------------------------------------- -! - call ESMF_StateGet(importState, itemCount=itemCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! - if (.not. allocated(itemNameList)) then - allocate(itemNameList(itemCount)) - end if - call ESMF_StateGet(importState, itemNameList=itemNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! -!----------------------------------------------------------------------- -! Create import fields -!----------------------------------------------------------------------- -! - do i = 1, itemCount - k = get_varid(models(Iatmos)%importField, trim(itemNameList(i))) -! -!----------------------------------------------------------------------- -! Check rank of the import field -!----------------------------------------------------------------------- -! - if (models(Iatmos)%importField(k)%rank .eq. 2) then -! -!----------------------------------------------------------------------- -! Set staggering type -!----------------------------------------------------------------------- -! - if (models(Iatmos)%importField(k)%gtype == Icross) then - staggerLoc = ESMF_STAGGERLOC_CENTER - else if (models(Iatmos)%importField(k)%gtype == Idot) then - staggerLoc = ESMF_STAGGERLOC_CORNER - end if -! -!----------------------------------------------------------------------- -! Create field -!----------------------------------------------------------------------- + if (ma%has_bdyright) then + ptrX(:,jde2+1) = ptrX(:,jde2)+(ptrX(:,jde2)-ptrX(:,jde2-1)) + ptrY(:,jde2+1) = ptrY(:,jde2)+(ptrY(:,jde2)-ptrY(:,jde2-1)) + end if ! - field = ESMF_FieldCreate(models(Iatmos)%grid, & - arraySpec, & - staggerloc=staggerLoc, & - name=trim(itemNameList(i)), & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return + if (ma%has_bdytop) then + ptrX(ide2+1,:) = ptrX(ide2,:)+(ptrX(ide2,:)-ptrX(ide2-1,:)) + ptrY(ide2+1,:) = ptrY(ide2,:)+(ptrY(ide2,:)-ptrY(ide2-1,:)) + end if ! -!----------------------------------------------------------------------- -! Put data into state -!----------------------------------------------------------------------- -! - do j = 0, localDECount-1 + ptrA = dxsq + else if (models(Iatmos)%mesh(i)%gtype == Icross) then + if (debugLevel > 0) then + write(*,30) localPet, j, adjustl("DAT/ATM/GRD/"//name), & + ice1, ice2, jce1, jce2, & + ma%has_bdybottom, ma%has_bdyright, & + ma%has_bdytop, ma%has_bdyleft + end if ! -!----------------------------------------------------------------------- -! Get pointer from field -!----------------------------------------------------------------------- + do i0 = ice1, ice2 + do j0 = jce1, jce2 + ptrX(i0,j0) = mddom%xlon(j0,i0) + ptrY(i0,j0) = mddom%xlat(j0,i0) + ptrM(i0,j0) = int(mddom%mask(j0,i0)) + end do + end do ! - call ESMF_FieldGet(field, localDe=j, farrayPtr=ptr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return + ptrA = dxsq ! -!----------------------------------------------------------------------- -! Initialize pointer -!----------------------------------------------------------------------- + if (ma%has_bdyright) then + ptrX(:,jce2+1) = ptrX(:,jce2)+(ptrX(:,jce2)-ptrX(:,jce2-1)) + ptrY(:,jce2+1) = ptrY(:,jce2)+(ptrY(:,jce2)-ptrY(:,jce2-1)) + end if ! - ptr = MISSING_R8 + if (ma%has_bdytop) then + ptrX(ice2+1,:) = ptrX(ice2,:)+(ptrX(ice2,:)-ptrX(ice2-1,:)) + ptrY(ice2+1,:) = ptrY(ice2,:)+(ptrY(ice2,:)-ptrY(ice2-1,:)) + end if + end if ! !----------------------------------------------------------------------- ! Nullify pointer to make sure that it does not point on a random ! part in the memory !----------------------------------------------------------------------- ! - if (associated(ptr)) then - nullify(ptr) + if (associated(ptrY)) then + nullify(ptrY) + end if + if (associated(ptrX)) then + nullify(ptrX) + end if + if (associated(ptrM)) then + nullify(ptrM) + end if + if (associated(ptrA)) then + nullify(ptrA) end if ! end do ! !----------------------------------------------------------------------- -! Add field import state +! Assign grid to gridded component !----------------------------------------------------------------------- ! - call NUOPC_Realize(importState, field=field, rc=rc) + call ESMF_GridCompSet(gcomp, grid=models(Iatmos)%grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME)) return ! - end if +!----------------------------------------------------------------------- +! Debug: write out component grid in VTK format +!----------------------------------------------------------------------- ! + if (debugLevel > 1) then + call ESMF_GridWriteVTK(models(Iatmos)%grid, & + filename="atmos_"// & + trim(GRIDDES(models(Iatmos)%mesh(i)%gtype))// & + "point", & + staggerLoc=staggerLoc, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=FILENAME)) return + end if end do ! !----------------------------------------------------------------------- -! Deallocate arrays +! Format definition !----------------------------------------------------------------------- ! - if (allocated(itemNameList)) deallocate(itemNameList) + 30 format(" PET(",I3.3,") - DE(",I2.2,") - ",A20," : ", & + 4I8," ",L," ",L," ",L," ",L) ! - end subroutine ATM_SetStates2d + end subroutine ATM_SetGridArrays ! - subroutine ATM_SetStates3d(gcomp, rc) + subroutine ATM_SetStates(gcomp, rc) implicit none ! !----------------------------------------------------------------------- @@ -1625,7 +902,7 @@ subroutine ATM_SetStates3d(gcomp, rc) !----------------------------------------------------------------------- ! integer :: i, j, k, localPet, petCount, itemCount, localDECount - real*8, dimension(:,:,:), pointer :: ptr + real*8, dimension(:,:), pointer :: ptr character(ESMF_MAXSTR), allocatable :: itemNameList(:) ! type(ESMF_VM) :: vm @@ -1654,7 +931,7 @@ subroutine ATM_SetStates3d(gcomp, rc) !----------------------------------------------------------------------- ! call ESMF_ArraySpecSet(arraySpec, typekind=ESMF_TYPEKIND_R8, & - rank=3, rc=rc) + rank=2, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME)) return ! @@ -1662,10 +939,10 @@ subroutine ATM_SetStates3d(gcomp, rc) ! Get number of local DEs !----------------------------------------------------------------------- ! - call ESMF_GridGet(models(Iatmos)%grid3d, & + call ESMF_GridGet(models(Iatmos)%grid, & localDECount=localDECount, & rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,& + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME)) return ! !----------------------------------------------------------------------- @@ -1691,12 +968,6 @@ subroutine ATM_SetStates3d(gcomp, rc) k = get_varid(models(Iatmos)%exportField, trim(itemNameList(i))) ! !----------------------------------------------------------------------- -! Check rank of the export field -!----------------------------------------------------------------------- -! - if (models(Iatmos)%exportField(k)%rank .eq. 3) then -! -!----------------------------------------------------------------------- ! Set staggering type !----------------------------------------------------------------------- ! @@ -1710,7 +981,7 @@ subroutine ATM_SetStates3d(gcomp, rc) ! Create field !----------------------------------------------------------------------- ! - field = ESMF_FieldCreate(models(Iatmos)%grid3d, & + field = ESMF_FieldCreate(models(Iatmos)%grid, & arraySpec, & staggerloc=staggerLoc, & name=trim(itemNameList(i)), & @@ -1756,16 +1027,13 @@ subroutine ATM_SetStates3d(gcomp, rc) call NUOPC_Realize(exportState, field=field, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME)) return -! - end if -! end do ! !----------------------------------------------------------------------- ! Deallocate arrays !----------------------------------------------------------------------- ! - if (allocated(itemNameList)) deallocate(itemNameList) + if (allocated(itemNameList)) deallocate(itemNameList) ! !----------------------------------------------------------------------- ! Get list of import fields @@ -1790,12 +1058,6 @@ subroutine ATM_SetStates3d(gcomp, rc) k = get_varid(models(Iatmos)%importField, trim(itemNameList(i))) ! !----------------------------------------------------------------------- -! Check rank of the import field -!----------------------------------------------------------------------- -! - if (models(Iatmos)%importField(k)%rank .eq. 3) then -! -!----------------------------------------------------------------------- ! Set staggering type !----------------------------------------------------------------------- ! @@ -1809,7 +1071,7 @@ subroutine ATM_SetStates3d(gcomp, rc) ! Create field !----------------------------------------------------------------------- ! - field = ESMF_FieldCreate(models(Iatmos)%grid3d, & + field = ESMF_FieldCreate(models(Iatmos)%grid, & arraySpec, & staggerloc=staggerLoc, & name=trim(itemNameList(i)), & @@ -1855,9 +1117,6 @@ subroutine ATM_SetStates3d(gcomp, rc) call NUOPC_Realize(importState, field=field, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME)) return -! - end if -! end do ! !----------------------------------------------------------------------- @@ -1866,7 +1125,7 @@ subroutine ATM_SetStates3d(gcomp, rc) ! if (allocated(itemNameList)) deallocate(itemNameList) ! - end subroutine ATM_SetStates3d + end subroutine ATM_SetStates ! subroutine ATM_ModelAdvance(gcomp, rc) ! @@ -1889,13 +1148,13 @@ subroutine ATM_ModelAdvance(gcomp, rc) ! Local variable declarations !----------------------------------------------------------------------- ! - real*8 :: tstr, tend, tint + real*8 :: tstr, tend integer :: localPet, petCount, phase character(ESMF_MAXSTR) :: str1, str2 ! type(ESMF_VM) :: vm - type(ESMF_Clock) :: clock, driverClock - type(ESMF_TimeInterval) :: timeStep, timeStepDrv, timeFrom, timeTo + type(ESMF_Clock) :: clock + type(ESMF_TimeInterval) :: timeStep, timeFrom, timeTo type(ESMF_Time) :: refTime, startTime, stopTime, currTime type(ESMF_State) :: importState, exportState ! @@ -2240,7 +1499,10 @@ subroutine ATM_Get(gcomp, rc) if (debugLevel == 3) then write(ofile,80) 'atm_import', trim(itemNameList(i)), & iyear, imonth, iday, ihour, localPet - call ESMF_FieldWrite(field, trim(ofile)//'.nc', rc=rc) + ! ALESS ( + !call ESMF_FieldWrite(field, trim(ofile)//'.nc', rc=rc) + call ESMF_FieldWrite(field, trim(ofile)//'.nc', overwrite=.true., rc=rc) + ! ALESS ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME)) return end if @@ -2270,16 +1532,8 @@ subroutine ATM_Put(gcomp, rc) ! Used module declarations !----------------------------------------------------------------------- ! - use mod_constants, only : regrav, d_100 - use mod_hgt, only : htsig_s, nonhydrost_s - use mod_vertint, only : intlinregz - use mod_mppparam, only : ma - use mod_update, only : exportFields, exportFields3d + use mod_update, only : exportFields use mod_dynparam, only : ici1, ici2, jci1, jci2 - use mod_dynparam, only : ice1, ice2, jce1, jce2 - use mod_dynparam, only : kz, ptop, idynamic - use mod_atm_interface, only : mddom - use mod_runparams, only : sigma ! implicit none ! @@ -2294,14 +1548,12 @@ subroutine ATM_Put(gcomp, rc) ! Local variable declarations !----------------------------------------------------------------------- ! - integer :: i, j, k, ii, jj, dd, m, n, nz, imin, imax, jmin, jmax - integer :: iyear, iday, imonth, ihour, iminute, isec, iunit + integer :: i, j, ii, jj, dd, m, n, imin, imax, jmin, jmax + integer :: iyear, iday, imonth, ihour, iunit integer :: petCount, localPet, itemCount, localDECount character(ESMF_MAXSTR) :: cname, ofile character(ESMF_MAXSTR), allocatable :: itemNameList(:) - real(ESMF_KIND_R8), pointer :: ptr2d(:,:) - real(ESMF_KIND_R8), pointer :: ptr3d(:,:,:) - real(ESMF_KIND_R8), allocatable :: zvar(:,:,:), hzvar(:,:,:) + real(ESMF_KIND_R8), pointer :: ptr(:,:) integer(ESMF_KIND_I8) :: tstep ! type(ESMF_VM) :: vm @@ -2337,12 +1589,21 @@ subroutine ATM_Put(gcomp, rc) line=__LINE__, file=FILENAME)) return ! call ESMF_TimeGet(currTime, yy=iyear, mm=imonth, & - dd=iday, h=ihour, m=iminute, s=isec, rc=rc) + dd=iday, h=ihour, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME)) return end if ! !----------------------------------------------------------------------- +! Get number of local DEs +!----------------------------------------------------------------------- +! + call ESMF_GridGet(models(Iatmos)%grid, & + localDECount=localDECount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=FILENAME)) return +! +!----------------------------------------------------------------------- ! Get list of export fields !----------------------------------------------------------------------- ! @@ -2373,23 +1634,6 @@ subroutine ATM_Put(gcomp, rc) !----------------------------------------------------------------------- ! do i = 1, itemCount -! - k = get_varid(models(Iatmos)%exportField, trim(itemNameList(i))) -! -!----------------------------------------------------------------------- -! Check rank of the export field -!----------------------------------------------------------------------- -! - if (models(Iatmos)%exportField(k)%rank .eq. 2) then -! -!----------------------------------------------------------------------- -! Get number of local DEs -!----------------------------------------------------------------------- -! - call ESMF_GridGet(models(Iatmos)%grid, & - localDECount=localDECount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return ! !----------------------------------------------------------------------- ! Get field from export state @@ -2410,7 +1654,7 @@ subroutine ATM_Put(gcomp, rc) ! Get pointer from field !----------------------------------------------------------------------- ! - call ESMF_FieldGet(field, localDE=j, farrayPtr=ptr2d, rc=rc) + call ESMF_FieldGet(field, localDE=j, farrayPtr=ptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME)) return ! @@ -2418,7 +1662,7 @@ subroutine ATM_Put(gcomp, rc) ! Set initial value to missing !----------------------------------------------------------------------- ! - ptr2d = MISSING_R8 + ptr = MISSING_R8 ! !----------------------------------------------------------------------- ! Put data to export field @@ -2428,103 +1672,103 @@ subroutine ATM_Put(gcomp, rc) case ('psfc') do m = ici1, ici2 do n = jci1, jci2 - ptr2d(m,n) = exportFields%psfc(n,m) + ptr(m,n) = exportFields%psfc(n,m) end do end do case ('tsfc') do m = ici1, ici2 do n = jci1, jci2 - ptr2d(m,n) = exportFields%tsfc(n,m) + ptr(m,n) = exportFields%tsfc(n,m) end do end do case ('qsfc') do m = ici1, ici2 do n = jci1, jci2 - ptr2d(m,n) = exportFields%qsfc(n,m) + ptr(m,n) = exportFields%qsfc(n,m) end do end do case ('lwrd') do m = ici1, ici2 do n = jci1, jci2 - ptr2d(m,n) = exportFields%lwrd(n,m) + ptr(m,n) = exportFields%lwrd(n,m) end do end do case ('dlwr') do m = ici1, ici2 do n = jci1, jci2 - ptr2d(m,n) = exportFields%dlwr(n,m) + ptr(m,n) = exportFields%dlwr(n,m) end do end do case ('lhfx') do m = ici1, ici2 do n = jci1, jci2 - ptr2d(m,n) = exportFields%lhfx(n,m) + ptr(m,n) = exportFields%lhfx(n,m) end do end do case ('shfx') do m = ici1, ici2 do n = jci1, jci2 - ptr2d(m,n) = exportFields%shfx(n,m) + ptr(m,n) = exportFields%shfx(n,m) end do end do case ('prec') do m = ici1, ici2 do n = jci1, jci2 - ptr2d(m,n) = exportFields%prec(n,m) + ptr(m,n) = exportFields%prec(n,m) end do end do case ('wndu') do m = ici1, ici2 do n = jci1, jci2 - ptr2d(m,n) = exportFields%wndu(n,m) + ptr(m,n) = exportFields%wndu(n,m) end do end do case ('wndv') do m = ici1, ici2 do n = jci1, jci2 - ptr2d(m,n) = exportFields%wndv(n,m) + ptr(m,n) = exportFields%wndv(n,m) end do end do case ('swrd') do m = ici1, ici2 do n = jci1, jci2 - ptr2d(m,n) = exportFields%swrd(n,m) + ptr(m,n) = exportFields%swrd(n,m) end do end do case ('dswr') do m = ici1, ici2 do n = jci1, jci2 - ptr2d(m,n) = exportFields%dswr(n,m) + ptr(m,n) = exportFields%dswr(n,m) end do end do case ('rnof') do m = ici1, ici2 do n = jci1, jci2 - ptr2d(m,n) = exportFields%rnof(n,m) + ptr(m,n) = exportFields%rnof(n,m) end do end do case ('snof') do m = ici1, ici2 do n = jci1, jci2 - ptr2d(m,n) = exportFields%snof(n,m) + ptr(m,n) = exportFields%snof(n,m) end do end do case ('taux') do m = ici1, ici2 do n = jci1, jci2 - ptr2d(m,n) = exportFields%taux(n,m) + ptr(m,n) = exportFields%taux(n,m) end do end do case ('tauy') do m = ici1, ici2 do n = jci1, jci2 - ptr2d(m,n) = exportFields%tauy(n,m) + ptr(m,n) = exportFields%tauy(n,m) end do end do case ('wspd') do m = ici1, ici2 do n = jci1, jci2 - ptr2d(m,n) = exportFields%wspd(n,m) + ptr(m,n) = exportFields%wspd(n,m) end do end do case ('wdir') @@ -2532,74 +1776,36 @@ subroutine ATM_Put(gcomp, rc) do n = jci1, jci2 dd = atan2(exportFields%wndu(n,m), exportFields%wndv(n,m)) if (dd < ZERO_R8) dd = dd+pi2 - ptr2d(m,n) = dd + ptr(m,n) = dd end do end do case ('ustr') do m = ici1, ici2 do n = jci1, jci2 - ptr2d(m,n) = exportFields%ustr(n,m) + ptr(m,n) = exportFields%ustr(n,m) end do end do case ('nflx') do m = ici1, ici2 do n = jci1, jci2 - ptr2d(m,n) = exportFields%nflx(n,m) + ptr(m,n) = exportFields%nflx(n,m) end do end do case ('sflx') do m = ici1, ici2 do n = jci1, jci2 - ptr2d(m,n) = exportFields%sflx(n,m) + ptr(m,n) = exportFields%sflx(n,m) end do end do case ('snow') do m = ici1, ici2 do n = jci1, jci2 - ptr2d(m,n) = exportFields%snow(n,m) - end do - end do - case ('topo') - do m = ici1, ici2 - do n = jci1, jci2 - ptr2d(m,n) = mddom%ht(n,m)*regrav - end do - end do - case ('mask') - do m = ici1, ici2 - do n = jci1, jci2 - if ((mddom%mask(n,m) > ONE_R8)) then - ptr2d(m,n) = ONE_R8 - else - ptr2d(m,n) = ZERO_R8 - end if + ptr(m,n) = exportFields%snow(n,m) end do end do end select ! !----------------------------------------------------------------------- -! Fill domain boundaries with data -!----------------------------------------------------------------------- -! - if (ma%has_bdytop) then ! right - ptr2d(ice2,:) = ptr2d(ice2-1,:) - ptr2d(ice2+1,:) = ptr2d(ice2-1,:) - end if -! - if (ma%has_bdybottom) then ! left - ptr2d(ice1,:) = ptr2d(ice1+1,:) - end if -! - if (ma%has_bdyright) then !top - ptr2d(:,jce2) = ptr2d(:,jce2-1) - ptr2d(:,jce2+1) = ptr2d(:,jce2-1) - end if -! - if (ma%has_bdyleft) then ! bottom - ptr2d(:,jce1) = ptr2d(:,jce1+1) - end if -! -!----------------------------------------------------------------------- ! Debug: write field in ASCII format !----------------------------------------------------------------------- ! @@ -2608,7 +1814,7 @@ subroutine ATM_Put(gcomp, rc) write(ofile,90) 'atm_export', trim(itemNameList(i)), & iyear, imonth, iday, ihour, localPet, j open(unit=iunit, file=trim(ofile)//'.txt') - call print_matrix(transpose(ptr2d), ici1, ici2, jci1, jci2, & + call print_matrix(transpose(ptr), ici1, ici2, jci1, jci2, & 1, 1, localPet, iunit, "PTR/ATM/EXP") close(unit=iunit) end if @@ -2618,172 +1824,11 @@ subroutine ATM_Put(gcomp, rc) ! part in the memory !----------------------------------------------------------------------- ! - if (associated(ptr2d)) then - nullify(ptr2d) - end if -! - end do -! - else if (models(Iatmos)%exportField(k)%rank .eq. 3) then -! -!----------------------------------------------------------------------- -! Get number of local DEs -!----------------------------------------------------------------------- -! - call ESMF_GridGet(models(Iatmos)%grid3d, & - localDECount=localDECount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! -!----------------------------------------------------------------------- -! Get field from export state -!----------------------------------------------------------------------- -! - call ESMF_StateGet(exportState, trim(itemNameList(i)), & - field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! -!----------------------------------------------------------------------- -! Loop over decomposition elements (DEs) -!----------------------------------------------------------------------- -! - do j = 0, localDECount-1 -! -!----------------------------------------------------------------------- -! Get pointer from field -!----------------------------------------------------------------------- -! - call ESMF_FieldGet(field, localDE=j, farrayPtr=ptr3d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=FILENAME)) return -! -!----------------------------------------------------------------------- -! Set initial value to missing -!----------------------------------------------------------------------- -! - ptr3d = MISSING_R8 -! -!----------------------------------------------------------------------- -! Calculate heights on sigma surfaces -!----------------------------------------------------------------------- -! - if (.not. allocated(hzvar)) then - allocate(hzvar(jce1:jce2,ice1:ice2,kz)) - hzvar = ZERO_R8 - end if -! - if (idynamic == 1) then - call htsig_s(exportFields3d%t, hzvar, exportFields%psfc*d_100,& - mddom%ht(jce1:jce2,ice1:ice2)*regrav, & - sigma, ptop*d_100, jce1, jce2, ice1, ice2, kz) - else -! call nonhydrost_s(hzvar, exportFields3d%t, & -! (exportFields%psfc-ptop)*d_100, ptop*d_100, & -! mddom%ht(jce1:jce2,ice1:ice2), sigma, & -! jce1, jce2, ice1, ice2, kz) - call nonhydrost_s(hzvar, exportFields3d%t, & - (exportFields%psfc-ptop)*d_100, ptop, & - mddom%ht(jce1:jce2,ice1:ice2)*regrav, sigma, & - jce1, jce2, ice1, ice2, kz) - end if -! -!----------------------------------------------------------------------- -! Perform vertical interpolation from aigma to height -!----------------------------------------------------------------------- -! - nz = models(Iatmos)%nLevs -! - if (.not. allocated(zvar)) then - allocate(zvar(jce1:jce2,ice1:ice2,nz)) - zvar = ZERO_R8 - end if -! - select case (trim(adjustl(itemNameList(i)))) - case ('tlev') - call intlinregz(zvar, exportFields3d%t, hzvar, sigma, & - jce1, jce2, ice1, ice2, kz, & - models(Iatmos)%levs,nz) - case ('qlev') - call intlinregz(zvar, exportFields3d%q, hzvar, sigma, & - jce1, jce2, ice1, ice2, kz, & - models(Iatmos)%levs,nz) - case ('ulev') - call intlinregz(zvar, exportFields3d%u, hzvar, sigma, & - jce1, jce2, ice1, ice2, kz, & - models(Iatmos)%levs,nz) - case ('vlev') - call intlinregz(zvar, exportFields3d%v, hzvar, sigma, & - jce1, jce2, ice1, ice2, kz, & - models(Iatmos)%levs,nz) - case ('wlev') - call intlinregz(zvar, exportFields3d%w, hzvar, sigma, & - jce1, jce2, ice1, ice2, kz, & - models(Iatmos)%levs,nz) - case ('cldfrc') - call intlinregz(zvar, exportFields3d%cldfrc, hzvar, sigma, & - jce1, jce2, ice1, ice2, kz, & - models(Iatmos)%levs,nz) - case ('cldlwc') - call intlinregz(zvar, exportFields3d%cldlwc, hzvar, sigma, & - jce1, jce2, ice1, ice2, kz, & - models(Iatmos)%levs,nz) - end select -! -!----------------------------------------------------------------------- -! Put data to export field -!----------------------------------------------------------------------- -! - do k = 1 , nz - do m = ice1, ice2 - do n = jce1, jce2 - ptr3d(m,n,k) = zvar(n,m,k) - end do - end do - end do -! -!----------------------------------------------------------------------- -! Fill domain boundaries with data -!----------------------------------------------------------------------- -! - if (ma%has_bdytop) then ! right - do k = 1 , nz - ptr3d(ice2,:,k) = ptr3d(ice2-1,:,k) - ptr3d(ice2+1,:,k) = ptr3d(ice2-1,:,k) - end do - end if -! - if (ma%has_bdybottom) then ! left - do k = 1 , nz - ptr3d(ice1,:,k) = ptr3d(ice1+1,:,k) - end do - end if -! - if (ma%has_bdyright) then !top - do k = 1 , nz - ptr3d(:,jce2,k) = ptr3d(:,jce2-1,k) - ptr3d(:,jce2+1,k) = ptr3d(:,jce2-1,k) - end do - end if -! - if (ma%has_bdyleft) then ! bottom - do k = 1 , nz - ptr3d(:,jce1,k) = ptr3d(:,jce1+1,k) - end do - end if -! -!----------------------------------------------------------------------- -! Nullify pointer to make sure that it does not point on a random -! part in the memory -!----------------------------------------------------------------------- -! - if (associated(ptr3d)) then - nullify(ptr3d) + if (associated(ptr)) then + nullify(ptr) end if ! end do -! - end if ! !----------------------------------------------------------------------- ! Debug: write field in netCDF format @@ -2791,10 +1836,11 @@ subroutine ATM_Put(gcomp, rc) ! if (debugLevel == 3) then write(ofile,100) 'atm_export', trim(itemNameList(i)), & - iyear, imonth, iday, ihour, iminute, isec - call ESMF_FieldWrite(field, trim(ofile)//'.nc', & - variableName='data', overwrite=.true., & - rc=rc) + iyear, imonth, iday, ihour, localPet + ! ALESS ( + !call ESMF_FieldWrite(field, trim(ofile)//'.nc', rc=rc) + call ESMF_FieldWrite(field, trim(ofile)//'.nc', overwrite=.true., rc=rc) + ! ALESS ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME)) return end if @@ -2807,17 +1853,13 @@ subroutine ATM_Put(gcomp, rc) ! if (allocated(itemNameList)) deallocate(itemNameList) if (allocated(itemTypeList)) deallocate(itemTypeList) - if (allocated(zvar)) deallocate(zvar) - if (allocated(hzvar)) deallocate(hzvar) ! !----------------------------------------------------------------------- ! Format definition !----------------------------------------------------------------------- ! - 90 format(A10,'_',A,'_', & - I4,'-',I2.2,'-',I2.2,'_',I2.2,'_',I2.2,'_',I1) - 100 format(A10,'_',A,'_', & - I4,'-',I2.2,'-',I2.2,'_',I2.2,'_',I2.2,'_',I2.2) + 90 format(A10,'_',A,'_',I4,'-',I2.2,'-',I2.2,'_',I2.2,'_',I2.2,'_',I1) + 100 format(A10,'_',A,'_',I4,'-',I2.2,'-',I2.2,'_',I2.2,'_',I2.2) ! end subroutine ATM_Put ! diff --git a/mod_esmf_atm_wrf.F90 b/mod_esmf_atm_wrf.F90 index f411de4..e0e0f93 100644 --- a/mod_esmf_atm_wrf.F90 +++ b/mod_esmf_atm_wrf.F90 @@ -2170,7 +2170,7 @@ subroutine ATM_Get(gcomp, rc) end do end do end select -! + !----------------------------------------------------------------------- ! Debug: write field in ASCII format !----------------------------------------------------------------------- @@ -2268,6 +2268,9 @@ subroutine ATM_Put(gcomp, rc) real(ESMF_KIND_R8), pointer :: ptr3d(:,:,:) real(ESMF_KIND_R8), allocatable :: varout(:,:,:) integer(ESMF_KIND_I8) :: tstep + real(ESMF_KIND_R8), save, allocatable :: total_precip_stored(:,:) + real(ESMF_KIND_R8), allocatable :: total_precip_tmp(:,:) + logical, save :: firsttime = .true. ! type(ESMF_VM) :: vm type(ESMF_Clock) :: clock @@ -2448,13 +2451,40 @@ subroutine ATM_Put(gcomp, rc) ptr2d(m,n) = head_grid%HFX(m,n) end do end do - case ('prec') + case ('evap') do m = ips, ipe do n = jps, jpe - ptr2d(m,n) = (head_grid%RAINCV(m,n)+head_grid%RAINNCV(m,n))/& - head_grid%DT + ptr2d(m,n) = head_grid%QFX(m,n) end do end do + case ('prec') + do m = ips, ipe + do n = jps, jpe + ptr2d(m,n) = head_grid%RAINC(m,n)+head_grid%RAINNC(m,n)+head_grid%RAINSH(m,n) + end do + end do + ! store initial data of accumulated prec. + if (firsttime .and. .not. restarted) then + if (.not. allocated(total_precip_stored)) allocate(total_precip_stored(ips:ipe,jps:jpe)) + total_precip_stored(ips:ipe,jps:jpe) = ZERO_R8 + ptr2d(ips:ipe,jps:jpe) = (ptr2d(ips:ipe,jps:jpe)-total_precip_stored(ips:ipe,jps:jpe)) / ((24./connectors(Iatmos,Iocean)%divDT) * 60 * 60) ! Convert mm to mm/s + write(*,fmt="(A,I5.5,F15.8)") "Initialize rain,firsttime and not restart->",localPet,maxval(total_precip_stored(ips:ipe,jps:jpe))*3600. + firsttime = .false. + else if (firsttime .and. restarted) then + if (.not. allocated(total_precip_stored)) allocate(total_precip_stored(ips:ipe,jps:jpe)) + total_precip_stored(ips:ipe,jps:jpe) = ptr2d(ips:ipe,jps:jpe) + ! First guess...there is no rain at first time step after restart + ptr2d(ips:ipe,jps:jpe) = (ptr2d(ips:ipe,jps:jpe)-total_precip_stored(ips:ipe,jps:jpe)) / ((24./connectors(Iatmos,Iocean)%divDT) * 60 * 60) ! Convert mm to mm/s + write(*,fmt="(A,I5.5,F15.8)") "Initialize rain,firsttime and restart->",localPet,maxval(total_precip_stored(ips:ipe,jps:jpe)) + firsttime = .false. + else + if (.not. allocated(total_precip_tmp)) allocate(total_precip_tmp(ips:ipe,jps:jpe)) + total_precip_tmp(ips:ipe,jps:jpe) = ptr2d(ips:ipe,jps:jpe) + ptr2d(ips:ipe,jps:jpe) = (ptr2d(ips:ipe,jps:jpe)-total_precip_stored(ips:ipe,jps:jpe)) / ((24./connectors(Iatmos,Iocean)%divDT) * 60 * 60) ! Convert mm to mm/s + total_precip_stored(ips:ipe,jps:jpe) = total_precip_tmp(ips:ipe,jps:jpe) + write(*,fmt="(A,I5.5,3F15.8)") "Precipitation Decumulated (mm/h) = ", & + localPet,minval(ptr2d(ips:ipe,jps:jpe))*3600.,maxval(ptr2d(ips:ipe,jps:jpe))*3600.,maxval(total_precip_stored(ips:ipe,jps:jpe)) + end if case ('wndu') do m = ips, ipe do n = jps, jpe @@ -2552,8 +2582,8 @@ subroutine ATM_Put(gcomp, rc) case ('nflx') do m = ips, ipe do n = jps, jpe - ptr2d(m,n) = head_grid%GSW(m,n)- & - (head_grid%GLW(m,n)-(STBOLT*head_grid%EMISS(m,n)*head_grid%SST(m,n)**4))-& + ptr2d(m,n) = head_grid%GSW(m,n)+ & + (head_grid%EMISS(m,n)*head_grid%GLW(m,n)-(STBOLT*head_grid%EMISS(m,n)*head_grid%SST(m,n)**4))-& head_grid%LH(m,n)- & head_grid%HFX(m,n) end do @@ -2565,9 +2595,10 @@ subroutine ATM_Put(gcomp, rc) (head_grid%GLW(m,n)-(STBOLT*head_grid%EMISS(m,n)*head_grid%SST(m,n)**4)) end do end do - case ('sflx') + case ('sflx') ! This works fine when no adaptive time step is used in WRF, otherwise is better using E-P do m = ips, ipe do n = jps, jpe + ! http://forum.wrfforum.com/viewtopic.php?f=32&t=5580 ptr2d(m,n) = head_grid%QFX(m,n)- & (head_grid%RAINCV(m,n)+head_grid%RAINNCV(m,n))/ & head_grid%DT @@ -2876,4 +2907,3 @@ integer function locate(xx,x) end function locate ! end module mod_esmf_atm - diff --git a/mod_esmf_ocn_mit.F90 b/mod_esmf_ocn_mit.F90 index 7954eb0..5eb5d3d 100644 --- a/mod_esmf_ocn_mit.F90 +++ b/mod_esmf_ocn_mit.F90 @@ -1972,7 +1972,10 @@ subroutine OCN_Get(gcomp, rc) if (debugLevel == 3) then write(ofile,80) 'ocn_import', trim(itemNameList(i)), & iyear, imonth, iday, ihour, iminute, isec - call ESMF_FieldWrite(field, trim(ofile)//'.nc', rc=rc) + ! ALESS ( + !call ESMF_FieldWrite(field, trim(ofile)//'.nc', rc=rc) + call ESMF_FieldWrite(field, trim(ofile)//'.nc', overwrite=.true., rc=rc) + ! ALESS ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME)) return end if @@ -2188,7 +2191,10 @@ subroutine OCN_Put(gcomp, rc) if (debugLevel == 3) then write(ofile,100) 'ocn_export', trim(itemNameList(i)), & iyear, imonth, iday, ihour, iminute, isec - call ESMF_FieldWrite(field, trim(ofile)//'.nc', rc=rc) + ! ALESS ( + !call ESMF_FieldWrite(field, trim(ofile)//'.nc', rc=rc) + call ESMF_FieldWrite(field, trim(ofile)//'.nc', overwrite=.true., rc=rc) + ! ALESS ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME)) return end if @@ -2428,4 +2434,3 @@ function findPet(vm, i, j, rc) end function findPet ! end module mod_esmf_ocn - diff --git a/mod_esmf_rtm.F90 b/mod_esmf_rtm.F90 index 1ef6a9e..7e40be2 100644 --- a/mod_esmf_rtm.F90 +++ b/mod_esmf_rtm.F90 @@ -1198,7 +1198,10 @@ subroutine RTM_Get(gcomp, rc) if (debugLevel == 3) then write(ofile,80) 'rtm_import', trim(itemNameList(i)), & iyear, imonth, iday, ihour, localPet - call ESMF_FieldWrite(field, trim(ofile)//'.nc', rc=rc) + ! ALESS ( + !call ESMF_FieldWrite(field, trim(ofile)//'.nc', rc=rc) + call ESMF_FieldWrite(field, trim(ofile)//'.nc', overwrite=.true., rc=rc) + ! ALESS ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME)) return end if @@ -1404,7 +1407,10 @@ subroutine RTM_Put(gcomp, rc) if (debugLevel == 3) then write(ofile,90) 'rtm_export', trim(itemNameList(i)), & iyear, imonth, iday, ihour, localPet - call ESMF_FieldWrite(field, trim(ofile)//'.nc', rc=rc) + ! ALESS ( + !call ESMF_FieldWrite(field, trim(ofile)//'.nc', rc=rc) + call ESMF_FieldWrite(field, trim(ofile)//'.nc', overwrite=.true., rc=rc) + ! ALESS ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME)) return end if