From 8477b2afb3e6da49475ceed778855d5b686ea10a Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Thu, 30 Apr 2020 10:36:47 -0400 Subject: [PATCH] DATM updates and fixes (#8) --- DATM/AtmBundleCreate.F90 | 4 +- DATM/AtmExportFields.F90 | 241 --------------------- DATM/AtmFieldUtils.F90 | 248 ++++++++------------- DATM/AtmForce.F90 | 67 ++++-- DATM/AtmGridSetUp.F90 | 253 ---------------------- DATM/AtmGridUtils.F90 | 217 ++----------------- DATM/AtmImportFields.F90 | 67 ------ DATM/AtmInternalFields.F90 | 79 +++++-- DATM/AtmModel.F90 | 54 +---- DATM/Makefile | 10 +- DATM/datm.F90 | 430 ++++++++++--------------------------- 11 files changed, 336 insertions(+), 1334 deletions(-) delete mode 100644 DATM/AtmExportFields.F90 delete mode 100644 DATM/AtmGridSetUp.F90 delete mode 100644 DATM/AtmImportFields.F90 diff --git a/DATM/AtmBundleCreate.F90 b/DATM/AtmBundleCreate.F90 index fb29ae4..c830dc6 100644 --- a/DATM/AtmBundleCreate.F90 +++ b/DATM/AtmBundleCreate.F90 @@ -21,6 +21,8 @@ subroutine AtmBundleCreate(gcomp,importState, exportState, rc) character(len=ESMF_MAXSTR) :: aname, fnameb, fnamef character(len=ESMF_MAXSTR) :: msgString + character(len=*),parameter :: u_FILE_u = & + __FILE__ ! Initialize return code rc = ESMF_SUCCESS @@ -87,7 +89,7 @@ subroutine AtmBundleCreate(gcomp,importState, exportState, rc) write(msgString,'(i4,2a14,a16,2a14,a16)')ii,' added field ',trim(fnameb),' to AtmBundleBak', & ' and field ',trim(fnamef),' to AtmBundleFwd' - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) enddo call ESMF_LogWrite("User init routine AtmBundleCreate finished", ESMF_LOGMSG_INFO) diff --git a/DATM/AtmExportFields.F90 b/DATM/AtmExportFields.F90 deleted file mode 100644 index 0497b6e..0000000 --- a/DATM/AtmExportFields.F90 +++ /dev/null @@ -1,241 +0,0 @@ -module AtmExportFields - -#include "LocalDefs.F90" - - use ESMF - use AtmInternalFields, only : AtmFieldCount - use AtmInternalFields, only : AtmField_Definition - - implicit none - - private - - type(AtmField_Definition), public :: AtmFieldsToExport(AtmFieldCount) - !----------------------------------------------------------------------------- - ! Fortran array pointers - ! Fields for DAtm model - ! in Atm exportState - !----------------------------------------------------------------------------- - - real(kind=ESMF_KIND_R8), dimension(:,:), public, pointer :: dusfc - real(kind=ESMF_KIND_R8), dimension(:,:), public, pointer :: dvsfc - - real(kind=ESMF_KIND_R8), dimension(:,:), public, pointer :: zlowest - real(kind=ESMF_KIND_R8), dimension(:,:), public, pointer :: tlowest - real(kind=ESMF_KIND_R8), dimension(:,:), public, pointer :: qlowest - real(kind=ESMF_KIND_R8), dimension(:,:), public, pointer :: ulowest - real(kind=ESMF_KIND_R8), dimension(:,:), public, pointer :: vlowest - real(kind=ESMF_KIND_R8), dimension(:,:), public, pointer :: plowest - - real(kind=ESMF_KIND_R8), dimension(:,:), public, pointer :: dswrf - real(kind=ESMF_KIND_R8), dimension(:,:), public, pointer :: dlwrf - real(kind=ESMF_KIND_R8), dimension(:,:), public, pointer :: ulwrf - - real(kind=ESMF_KIND_R8), dimension(:,:), public, pointer :: lhtfl - real(kind=ESMF_KIND_R8), dimension(:,:), public, pointer :: shtfl - - real(kind=ESMF_KIND_R8), dimension(:,:), public, pointer :: vbdsf - real(kind=ESMF_KIND_R8), dimension(:,:), public, pointer :: vddsf - real(kind=ESMF_KIND_R8), dimension(:,:), public, pointer :: nbdsf - real(kind=ESMF_KIND_R8), dimension(:,:), public, pointer :: nddsf - - real(kind=ESMF_KIND_R8), dimension(:,:), public, pointer :: psurf - real(kind=ESMF_KIND_R8), dimension(:,:), public, pointer :: prate - real(kind=ESMF_KIND_R8), dimension(:,:), public, pointer :: snwrate - - ! called by Cap - public :: AtmExportFieldsSetUp - - contains - - !----------------------------------------------------------------------------- - - subroutine AtmExportFieldsSetUp - - integer :: ii - character(len=ESMF_MAXSTR) :: msgString - - ! default values - AtmFieldsToExport(:)%staggertype = 'center' - - ii = 0 - !----------------------------------------------------------------------------- - ! - !----------------------------------------------------------------------------- - - ii = ii + 1 - AtmFieldsToExport(ii)%standard_name = 'mean_zonal_moment_flx' - AtmFieldsToExport(ii)%field_name = 'Dusfc' - AtmFieldsToExport(ii)%file_varname = 'dusfc' - AtmFieldsToExport(ii)%unit_name = 'N/m2' - AtmFieldsToExport(ii)%farrayPtr => dusfc - - ii = ii + 1 - AtmFieldsToExport(ii)%standard_name = 'mean_merid_moment_flx' - AtmFieldsToExport(ii)%field_name = 'Dvsfc' - AtmFieldsToExport(ii)%file_varname = 'dvsfc' - AtmFieldsToExport(ii)%unit_name = 'N/m2' - AtmFieldsToExport(ii)%farrayPtr => dvsfc - - !----------------------------------------------------------------------------- - ! - !----------------------------------------------------------------------------- - - ii = ii + 1 - AtmFieldsToExport(ii)%standard_name = 'inst_height_lowest' - AtmFieldsToExport(ii)%field_name = 'Zlowest' - AtmFieldsToExport(ii)%file_varname = 'hgt_hyblev1' - AtmFieldsToExport(ii)%unit_name = 'K' - AtmFieldsToExport(ii)%farrayPtr => zlowest - - ii = ii + 1 - AtmFieldsToExport(ii)%standard_name = 'inst_temp_height_lowest' - AtmFieldsToExport(ii)%field_name = 'Tlowest' - AtmFieldsToExport(ii)%file_varname = 'tmp_hyblev1' - AtmFieldsToExport(ii)%unit_name = 'K' - AtmFieldsToExport(ii)%farrayPtr => tlowest - - ii = ii + 1 - AtmFieldsToExport(ii)%standard_name = 'inst_spec_humid_height_lowest' - AtmFieldsToExport(ii)%field_name = 'Qlowest' - AtmFieldsToExport(ii)%file_varname = 'spfh_hyblev1' - AtmFieldsToExport(ii)%unit_name = 'kg/kg' - AtmFieldsToExport(ii)%farrayPtr => qlowest - - ii = ii + 1 - AtmFieldsToExport(ii)%standard_name = 'inst_zonal_wind_height_lowest' - AtmFieldsToExport(ii)%field_name = 'Ulowest' - AtmFieldsToExport(ii)%file_varname = 'ugrd_hyblev1' - AtmFieldsToExport(ii)%unit_name = 'm/s' - AtmFieldsToExport(ii)%farrayPtr => ulowest - - ii = ii + 1 - AtmFieldsToExport(ii)%standard_name = 'inst_merid_wind_height_lowest' - AtmFieldsToExport(ii)%field_name = 'Vlowest' - AtmFieldsToExport(ii)%file_varname = 'vgrd_hyblev1' - AtmFieldsToExport(ii)%unit_name = 'm/s' - AtmFieldsToExport(ii)%farrayPtr => vlowest - - ii = ii + 1 - AtmFieldsToExport(ii)%standard_name = 'inst_pres_height_lowest' - AtmFieldsToExport(ii)%field_name = 'Plowest' - AtmFieldsToExport(ii)%file_varname = 'pres_hyblev1' - AtmFieldsToExport(ii)%unit_name = 'Pa' - AtmFieldsToExport(ii)%farrayPtr => plowest - - !----------------------------------------------------------------------------- - ! - !----------------------------------------------------------------------------- - - ii = ii + 1 - AtmFieldsToExport(ii)%standard_name = 'mean_down_sw_flx' - AtmFieldsToExport(ii)%field_name = 'Dswrf' - AtmFieldsToExport(ii)%file_varname = 'DSWRF' - AtmFieldsToExport(ii)%unit_name = 'W/m2' - AtmFieldsToExport(ii)%farrayPtr => dswrf - - ii = ii + 1 - AtmFieldsToExport(ii)%standard_name = 'mean_down_lw_flx' - AtmFieldsToExport(ii)%field_name = 'Dlwrf' - AtmFieldsToExport(ii)%file_varname = 'DLWRF' - AtmFieldsToExport(ii)%unit_name = 'W/m2' - AtmFieldsToExport(ii)%farrayPtr => dlwrf - - ii = ii + 1 - AtmFieldsToExport(ii)%standard_name = 'mean_up_lw_flx' - AtmFieldsToExport(ii)%field_name = 'Ulwrf' - AtmFieldsToExport(ii)%file_varname = 'ULWRF' - AtmFieldsToExport(ii)%unit_name = 'W/m2' - AtmFieldsToExport(ii)%farrayPtr => ulwrf - - !----------------------------------------------------------------------------- - ! - !----------------------------------------------------------------------------- - - ii = ii + 1 - AtmFieldsToExport(ii)%standard_name = 'mean_sensi_heat_flx' - AtmFieldsToExport(ii)%field_name = 'Shtfl' - AtmFieldsToExport(ii)%file_varname = 'shtfl_ave' - AtmFieldsToExport(ii)%unit_name = 'W/m2' - AtmFieldsToExport(ii)%farrayPtr => shtfl - - ii = ii + 1 - AtmFieldsToExport(ii)%standard_name = 'mean_laten_heat_flx' - AtmFieldsToExport(ii)%field_name = 'Lhtfl' - AtmFieldsToExport(ii)%file_varname = 'lhtfl_ave' - AtmFieldsToExport(ii)%unit_name = 'W/m2' - AtmFieldsToExport(ii)%farrayPtr => lhtfl - - !----------------------------------------------------------------------------- - ! - !----------------------------------------------------------------------------- - - ii = ii + 1 - AtmFieldsToExport(ii)%standard_name = 'mean_down_sw_vis_dir_flx' - AtmFieldsToExport(ii)%field_name = 'Vbdsf' - AtmFieldsToExport(ii)%file_varname = 'vbdsf_ave' - AtmFieldsToExport(ii)%unit_name = 'W/m2' - AtmFieldsToExport(ii)%farrayPtr => vbdsf - - ii = ii + 1 - AtmFieldsToExport(ii)%standard_name = 'mean_down_sw_vis_dif_flx' - AtmFieldsToExport(ii)%field_name = 'Vddsf' - AtmFieldsToExport(ii)%file_varname = 'vddsf_ave' - AtmFieldsToExport(ii)%unit_name = 'W/m2' - AtmFieldsToExport(ii)%farrayPtr => vddsf - - ii = ii + 1 - AtmFieldsToExport(ii)%standard_name = 'mean_down_sw_ir_dir_flx' - AtmFieldsToExport(ii)%field_name = 'Nbdsf' - AtmFieldsToExport(ii)%file_varname = 'nbdsf_ave' - AtmFieldsToExport(ii)%unit_name = 'W/m2' - AtmFieldsToExport(ii)%farrayPtr => nbdsf - - ii = ii + 1 - AtmFieldsToExport(ii)%standard_name = 'mean_down_sw_ir_dif_flx' - AtmFieldsToExport(ii)%field_name = 'Nddsf' - AtmFieldsToExport(ii)%file_varname = 'nddsf_ave' - AtmFieldsToExport(ii)%unit_name = 'W/m2' - AtmFieldsToExport(ii)%farrayPtr => nddsf - - !----------------------------------------------------------------------------- - ! - !----------------------------------------------------------------------------- - - ii = ii + 1 - AtmFieldsToExport(ii)%standard_name = 'inst_pres_height_surface' - AtmFieldsToExport(ii)%field_name = 'Psurf' - AtmFieldsToExport(ii)%file_varname = 'psurf' - AtmFieldsToExport(ii)%unit_name = 'Pa' - AtmFieldsToExport(ii)%farrayPtr => psurf - - ii = ii + 1 - AtmFieldsToExport(ii)%standard_name = 'mean_prec_rate' - AtmFieldsToExport(ii)%field_name = 'Prate' - AtmFieldsToExport(ii)%file_varname = 'precp' - AtmFieldsToExport(ii)%unit_name = 'kg/m2/s' - AtmFieldsToExport(ii)%farrayPtr => prate - - ii = ii + 1 - AtmFieldsToExport(ii)%standard_name = 'mean_fprec_rate' - AtmFieldsToExport(ii)%field_name = 'Snwrate' - AtmFieldsToExport(ii)%file_varname = 'fprecp' - AtmFieldsToExport(ii)%unit_name = 'kg/m2/s' - AtmFieldsToExport(ii)%farrayPtr => snwrate - - !----------------------------------------------------------------------------- - ! check - !----------------------------------------------------------------------------- - if(ii .ne. size(AtmFieldsToExport)) & - call ESMF_LogWrite("ERROR: check # AtmFieldsToExport", ESMF_LOGMSG_INFO) - - call ESMF_LogWrite('AtmFieldsToExport : ', ESMF_LOGMSG_INFO) - do ii = 1,size(AtmFieldsToExport) - write(msgString,'(i6,2(a2,a14),a2,a)')ii,' ',trim(AtmFieldsToExport(ii)%file_varname), & - ' ',trim(AtmFieldsToExport(ii)%field_name), & - ' ',trim(AtmFieldsToExport(ii)%standard_name) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - enddo - - end subroutine AtmExportFieldsSetUp -end module AtmExportFields diff --git a/DATM/AtmFieldUtils.F90 b/DATM/AtmFieldUtils.F90 index 60239da..18dce2f 100644 --- a/DATM/AtmFieldUtils.F90 +++ b/DATM/AtmFieldUtils.F90 @@ -6,9 +6,7 @@ module AtmFieldUtils use ESMF use NUOPC - use AtmInternalFields, only : AtmField_Definition - use AtmInternalFields, only : AtmIndexType - use AtmExportFields, only : AtmFieldsToExport + use AtmInternalFields implicit none @@ -23,6 +21,9 @@ module AtmFieldUtils public :: AtmForceFwd2Bak, AtmBundleCheck public :: AtmBundleIntp + character(len=*),parameter :: u_FILE_u = & + __FILE__ + contains !----------------------------------------------------------------------------- @@ -39,18 +40,21 @@ subroutine AtmFieldsAdvertise(state, field_defs, rc) rc = ESMF_SUCCESS ! number of items - nfields = size(field_defs) - !print *,'found nfields = ',nfields,' to advertise ',field_defs%field_name - + nfields = size(field_defs) + + ! create a shortname == standard_name for the fields in the state do ii = 1,nfields + field_defs(ii)%shortname = trim(trim(field_defs(ii)%standard_name)) + + call ESMF_LogWrite("Advertise Field "// & + trim(field_defs(ii)%standard_name)//" : "// & + trim(field_defs(ii)%shortname), ESMF_LOGMSG_INFO) + call NUOPC_Advertise(state, & StandardName=trim(field_defs(ii)%standard_name), & - name=trim(field_defs(ii)%field_name), & + name=trim(field_defs(ii)%shortname), & rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return enddo end subroutine AtmFieldsAdvertise @@ -89,28 +93,14 @@ subroutine AtmFieldsRealize(state, grid, field_defs, tag, rc) arrayspec=arrayspecR8, & indexflag=AtmIndexType, & staggerloc=staggerloc, & - name=trim(field_defs(ii)%field_name), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - connected = NUOPC_IsConnected(state, fieldName=trim(field_defs(ii)%field_name), rc=rc) - if( connected)write(msgString,*)'Field '//trim(field_defs(ii)%field_name)//' is connected ' - if(.not.connected)write(msgString,*)'Field '//trim(field_defs(ii)%field_name)//' is NOT connected ' - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - - call NUOPC_Realize(state, field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + name=trim(field_defs(ii)%shortname), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_Realize(state, grid, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(field, farrayPtr=field_defs(ii)%farrayPtr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return field_defs(ii)%farrayPtr = 0.0 !do j = lbound(field_defs(ii)%farrayPtr,2),ubound(field_defs(ii)%farrayPtr,2) @@ -146,52 +136,46 @@ subroutine AtmFieldCheck(importState, exportState, tag, rc) ! Check Fields !----------------------------------------------------------------------------- - nfields = size(AtmFieldsToExport) + nfields = size(AtmBundleFields) do ii = 1,nfields call ESMF_StateGet(exportState, & - itemName=trim(AtmFieldsToExport(ii)%field_name), & + itemName=trim(AtmBundleFields(ii)%shortname), & field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_FieldGet(field, farrayPtr=AtmFieldsToExport(ii)%farrayPtr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - write (msgString,*)trim(tag), ' AtmFieldsToExport ',& - trim(AtmFieldsToExport(ii)%field_name),' ',& - real(AtmFieldsToExport(ii)%farrayPtr(iprnt,jprnt),4) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - - !ijloc = maxloc(abs(AtmFieldsToExport(ii)%farrayPtr)) - !write (msgString,*)trim(tag), ' AtmFieldsToExport ',& - ! trim(AtmFieldsToExport(ii)%field_name),' maxloc ',& + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldGet(field, farrayPtr=AtmBundleFields(ii)%farrayPtr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !write (msgString,*)trim(tag), ' AtmBundleFields ',& + ! trim(AtmBundleFields(ii)%shortname),' ',& + ! real(AtmBundleFields(ii)%farrayPtr(iprnt,jprnt),4) + !call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + + !ijloc = maxloc(abs(AtmBundleFields(ii)%farrayPtr)) + !write (msgString,*)trim(tag), ' AtmBundleFields ',& + ! trim(AtmBundleFields(ii)%shortname),' maxloc ',& ! ijloc(1),ijloc(2),& - ! real(AtmFieldsToExport(ii)%farrayPtr(ijloc(1),ijloc(2)),4) - !call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - - write (msgString,*)trim(tag), ' AtmFieldsToExport ',& - trim(AtmFieldsToExport(ii)%field_name),' min,max,sum ',& - minval(real(AtmFieldsToExport(ii)%farrayPtr,4)),& - maxval(real(AtmFieldsToExport(ii)%farrayPtr,4)),& - sum(real(AtmFieldsToExport(ii)%farrayPtr,4)) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + ! real(AtmBundleFields(ii)%farrayPtr(ijloc(1),ijloc(2)),4) + !call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + + write (msgString,*)trim(tag), ' AtmBundleFields ',& + trim(AtmBundleFields(ii)%shortname),' min,max,sum ',& + minval(real(AtmBundleFields(ii)%farrayPtr,4)),& + maxval(real(AtmBundleFields(ii)%farrayPtr,4)),& + sum(real(AtmBundleFields(ii)%farrayPtr,4)) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) enddo end subroutine AtmFieldCheck !----------------------------------------------------------------------------- - subroutine AtmFieldDump(importState, exportState, tag, iicnt, rc) + subroutine AtmFieldDump(importState, exportState, tag, timestr, rc) type(ESMF_State) :: importState type(ESMF_State) :: exportState character(len=*), intent( in) :: tag - integer, intent( in) :: iicnt + character(len=*), intent( in) :: timestr integer, intent(out) :: rc ! Local variables @@ -207,31 +191,28 @@ subroutine AtmFieldDump(importState, exportState, tag, iicnt, rc) call ESMF_LogWrite("User routine AtmFieldDump started", ESMF_LOGMSG_INFO) - ! Atm variables in exportState - nfields = size(AtmFieldsToExport) + nfields = size(AtmBundleFields) do ii = 1,nfields call ESMF_StateGet(exportState, & - itemName = trim(AtmFieldsToExport(ii)%field_name), & + itemName = trim(AtmBundleFields(ii)%shortname), & field=field,rc=rc) - varname = trim(AtmFieldsToExport(ii)%standard_name) + varname = trim(AtmBundleFields(ii)%shortname) - if(trim(tag) .eq. 'before AtmRun')filename = 'field_atm_exportb_'//trim(varname)//'.nc' - if(trim(tag) .eq. 'after AtmRun')filename = 'field_atm_exporta_'//trim(varname)//'.nc' + if(trim(tag) .eq. 'before AtmRun')filename = 'field_atm_exportb_'//trim(timestr)//'.nc' + if(trim(tag) .eq. 'after AtmRun')filename = 'field_atm_exporta_'//trim(timestr)//'.nc' - !if(trim(varname) .eq. 'inst_pres_height_lowest')then write(msgString, '(a,i6)')'Writing exportState field '//trim(varname)//' to ' & - //trim(filename)//' iicnt = ',iicnt - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + //trim(filename) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) call ESMF_FieldWrite(field, & - fileName=filename, & - variableName=varname, & - overwrite=.true., & - timeslice=iicnt,rc=rc) + fileName =trim(filename), & + timeslice=1, & + overwrite=.true., rc=rc) !endif !if(iicnt .eq. 1)then ! write(msgString, *)'Writing exportState field ',trim(varname),' to ',trim(filename) - ! call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + ! call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) !endif enddo call ESMF_LogWrite("User routine AtmFieldDump finished", ESMF_LOGMSG_INFO) @@ -268,26 +249,17 @@ subroutine AtmForceFwd2Bak(rc) call ESMF_FieldBundleGet(AtmBundleFwd, & fieldName=trim(fnamefwd), & field=fieldfwd,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldBundleGet(AtmBundleBak, & fieldName=trim(fnamebak), & field=fieldbak,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! copy the fwd fields to the bak fields ! this function is defined (fieldout,fieldin) call ESMF_FieldCopy(fieldbak, fieldfwd, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return enddo call ESMF_LogWrite("User routine AtmForceFwd2Bak finished", ESMF_LOGMSG_INFO) @@ -325,30 +297,18 @@ subroutine AtmBundleCheck(tag,rc) call ESMF_FieldBundleGet(AtmBundleBak, & fieldName=trim(fnamebak), & field=fieldbak,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(fieldbak,farrayPtr=AtmBundleFields(ii)%farrayPtr_bak,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldBundleGet(AtmBundleFwd, & fieldName=trim(fnamefwd), & field=fieldfwd,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(fieldfwd,farrayPtr=AtmBundleFields(ii)%farrayPtr_fwd,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return write(msgString,'(i4,2(a2,a12),2f14.5)')ii,' ',trim(fnamebak), & ' ',trim(fnamefwd), & @@ -356,7 +316,7 @@ subroutine AtmBundleCheck(tag,rc) AtmBundleFields(ii)%farrayPtr_fwd(iprnt,jprnt) ! AtmBundleFields(ii)%farrayPtr_bak(152,60), & ! AtmBundleFields(ii)%farrayPtr_fwd(152,60) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) enddo call ESMF_LogWrite("User routine AtmBundleCheck finished", ESMF_LOGMSG_INFO) @@ -367,8 +327,6 @@ end subroutine AtmBundleCheck subroutine AtmBundleIntp(gcomp, importState, exportState, externalClock, hour, rc) - use AtmExportFields - use AtmInternalFields, only : hfwd,hbak use AtmInternalFields, only : iprnt,jprnt use AtmInternalFields, only : AtmBundleFields @@ -395,88 +353,70 @@ subroutine AtmBundleIntp(gcomp, importState, exportState, externalClock, hour, r call ESMF_LogWrite("User routine AtmBundleIntp started", ESMF_LOGMSG_INFO) - nfields = size(AtmFieldsToExport) + nfields = size(AtmBundleFields) do ii = 1,nfields call ESMF_StateGet(exportState, & - itemName=trim(AtmFieldsToExport(ii)%field_name), & + itemName=trim(AtmBundleFields(ii)%shortname), & field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, farrayPtr=AtmFieldsToExport(ii)%farrayPtr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call ESMF_FieldGet(field, farrayPtr=AtmBundleFields(ii)%farrayPtr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! get the corresponding _fwd and _bak fields - fnamefwd = trim(AtmFieldsToExport(ii)%field_name)//'_fwd' - fnamebak = trim(AtmFieldsToExport(ii)%field_name)//'_bak' + fnamefwd = trim(AtmBundleFields(ii)%field_name)//'_fwd' + fnamebak = trim(AtmBundleFields(ii)%field_name)//'_bak' call ESMF_FieldBundleGet(AtmBundleFwd, & fieldName=trim(fnamefwd), & field=fieldfwd,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(fieldfwd,farrayPtr=AtmBundleFields(ii)%farrayPtr_fwd,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldBundleGet(AtmBundleBak, & fieldName=trim(fnamebak), & field=fieldbak,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(fieldbak,farrayPtr=AtmBundleFields(ii)%farrayPtr_bak,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return !special case at initialization if(int(hour,4) .eq. 0)then - AtmFieldsToExport(ii)%farrayPtr = real(AtmBundleFields(ii)%farrayPtr_bak,8) + AtmBundleFields(ii)%farrayPtr = real(AtmBundleFields(ii)%farrayPtr_bak,8) else ! interpolate in time wf = hfwd - hour wb = hour - hbak wtot = wf+wb - AtmFieldsToExport(ii)%farrayPtr = real((wf*AtmBundleFields(ii)%farrayPtr_bak & - + wb*AtmBundleFields(ii)%farrayPtr_fwd)/wtot,8) + AtmBundleFields(ii)%farrayPtr = (wf*real(AtmBundleFields(ii)%farrayPtr_bak,8) & + + wb*real(AtmBundleFields(ii)%farrayPtr_fwd,8))/wtot endif !hour=0 - !ijloc = maxloc(abs(AtmFieldsToExport(ii)%farrayPtr)) + !ijloc = maxloc(abs(AtmBundleFields(ii)%farrayPtr)) !write (msgString,*)' AtmIntp ',& - ! trim(AtmFieldsToExport(ii)%field_name),' maxloc ',& + ! trim(AtmBundleFields(ii)%field_name),' maxloc ',& ! ijloc(1),ijloc(2),& - ! real(AtmFieldsToExport(ii)%farrayPtr(ijloc(1),ijloc(2)),4),& + ! real(AtmBundleFields(ii)%farrayPtr(ijloc(1),ijloc(2)),4),& ! real(AtmBundleFields(ii)%farrayPtr_bak(ijloc(1),ijloc(2)),4),& ! real(AtmBundleFields(ii)%farrayPtr_fwd(ijloc(1),ijloc(2)),4) - !call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + !call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) write (msgString,*)' AtmIntp ',& - trim(AtmFieldsToExport(ii)%field_name),& - real(AtmFieldsToExport(ii)%farrayPtr(iprnt,jprnt),4),& + trim(AtmBundleFields(ii)%shortname),& + real(AtmBundleFields(ii)%farrayPtr(iprnt,jprnt),4),& real(AtmBundleFields(ii)%farrayPtr_bak(iprnt,jprnt),4),& real(AtmBundleFields(ii)%farrayPtr_fwd(iprnt,jprnt),4) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - - !write (msgString,*)' AtmFieldsToExport ',& - ! trim(AtmFieldsToExport(ii)%field_name),' min,max,sum ',& - ! minval(real(AtmFieldsToExport(ii)%farrayPtr,4)),& - ! maxval(real(AtmFieldsToExport(ii)%farrayPtr,4)),& - ! sum(real(AtmFieldsToExport(ii)%farrayPtr,4)) - ! call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + + !write (msgString,*)' AtmBundleFields ',& + ! trim(AtmBundleFields(ii)%field_name),' min,max,sum ',& + ! minval(real(AtmBundleFields(ii)%farrayPtr,4)),& + ! maxval(real(AtmBundleFields(ii)%farrayPtr,4)),& + ! sum(real(AtmBundleFields(ii)%farrayPtr,4)) + ! call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) enddo call ESMF_LogWrite("User routine AtmBundleIntp finished", ESMF_LOGMSG_INFO) diff --git a/DATM/AtmForce.F90 b/DATM/AtmForce.F90 index 217a68b..214d6b1 100644 --- a/DATM/AtmForce.F90 +++ b/DATM/AtmForce.F90 @@ -23,6 +23,7 @@ subroutine AtmForce(gcomp,exportState,externalClock,initmode,rc) integer(kind=ESMF_KIND_I4) :: year, month, day, hour, jday integer :: ii,nfields + integer :: iii, iid, iiu character(len=ESMF_MAXSTR) :: varname character(len=ESMF_MAXSTR) :: filename @@ -35,6 +36,9 @@ subroutine AtmForce(gcomp,exportState,externalClock,initmode,rc) character(len=8) :: i2fmt = '(i2.2)' character(len=8) :: i4fmt = '(i4.4)' + character(len=*),parameter :: u_FILE_u = & + __FILE__ + ! Set initial values rc = ESMF_SUCCESS @@ -57,17 +61,11 @@ subroutine AtmForce(gcomp,exportState,externalClock,initmode,rc) else ! set the time interval to the forecast file interval call ESMF_TimeIntervalSet(timeStep, h=nfhout, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! find the time at the currtime + nfhout call ESMF_ClockGetNextTime(externalClock, nextTime, timestep=timeStep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(nextTime,yy=year,mm=month,dd=day,h=hour,dayOfYear=jday,rc=rc) write(cyear, i4fmt)year @@ -79,7 +77,7 @@ subroutine AtmForce(gcomp,exportState,externalClock,initmode,rc) call ESMF_TimeGet(nextTime,h_r8=hfwd,rc=rc) endif write(msgString,'(3a,f12.3)')'using ',trim(filename),' at fwd clock hour ',real(hfwd,4) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) ! read the Atm field data into the Fwd bundle nfields = size(AtmBundleFields) @@ -91,31 +89,56 @@ subroutine AtmForce(gcomp,exportState,externalClock,initmode,rc) call ESMF_FieldBundleGet(AtmBundleFwd, & fieldName=trim(AtmBundleFields(ii)%field_name)//'_fwd', & field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldRead(field, & fileName=trim(filename), & variableName = trim(varname), & rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(field,farrayPtr=AtmBundleFields(ii)%farrayPtr_fwd,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return write(msgString,'(i6,2a18,f14.5)')ii,' inside AtmForce ',trim(varname), & AtmBundleFields(ii)%farrayPtr_fwd(iprnt,jprnt) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) endif !isPresent enddo + ! Check for fields which are not Present but are needed + ! Not very clean---would have been better to create this field in the forcing file + nfields = size(AtmBundleFields) + do ii = 1,nfields + if(.not.AtmBundleFields(ii)%isPresent)then + varname = trim(AtmBundleFields(ii)%standard_name) + + ! get the '_fwd' field + call ESMF_FieldBundleGet(AtmBundleFwd, & + fieldName=trim(AtmBundleFields(ii)%field_name)//'_fwd', & + field=field, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldGet(field,farrayPtr=AtmBundleFields(ii)%farrayPtr_fwd,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if(trim(varname) .eq. 'mean_net_lw_flx')then + iid = 0; iiu = 0 + do iii = 1,nfields + if(trim(AtmBundleFields(iii)%standard_name) == 'mean_down_lw_flx')iid = iii + if(trim(AtmBundleFields(iii)%standard_name) == 'mean_up_lw_flx')iiu = iii + enddo + + if(iiu .eq. 0 .or. iid .eq. 0)then + call ESMF_LogWrite('Cannot create field '//trim(varname), ESMF_LOGMSG_INFO) + call ESMF_Finalize(endflag=ESMF_END_ABORT) + else + AtmBundleFields(ii)%farrayPtr_fwd = AtmBundleFields(iid)%farrayPtr_fwd & + - AtmBundleFields(iiu)%farrayPtr_fwd + endif + endif + endif !not present + enddo + call ESMF_LogWrite("User routine AtmForce finished", ESMF_LOGMSG_INFO) end subroutine AtmForce diff --git a/DATM/AtmGridSetUp.F90 b/DATM/AtmGridSetUp.F90 deleted file mode 100644 index 6f5c746..0000000 --- a/DATM/AtmGridSetUp.F90 +++ /dev/null @@ -1,253 +0,0 @@ -subroutine AtmGridSetUp(grid,petCnt,gridname,tag,rc) - -#include "LocalDefs.F90" - - use ESMF - use AtmInternalFields, only : lPet, iatm, jatm, dirpath, cdate0, filename_base - use AtmInternalFields, only : AtmIndexType - - use AtmGridUtils - - implicit none - - type(ESMF_Grid) :: grid - - integer, intent( in) :: petCnt - character(len=*), intent( in) :: gridname,tag - integer, intent(out) :: rc - - ! Local variables - type(ESMF_Array) :: array2d - - character(len=ESMF_MAXSTR) :: filename - character(len=ESMF_MAXSTR) :: msgString - - integer :: i,j,lde,peX,peY,peList(2),localDECount - integer(kind=ESMF_KIND_I4), pointer :: i4Ptr(:,:) - - integer(kind=ESMF_KIND_I4), allocatable :: cppeX(:), cppeY(:) - - ! gaussian grid center coords - real(kind=ESMF_KIND_R8), allocatable :: coordXc(:),coordYc(:) - ! gaussian grid corner coords - real(kind=ESMF_KIND_R8), allocatable :: coordXq(:),coordYq(:) - ! gaussian grid landsfc mask - real(kind=ESMF_KIND_R4), allocatable :: landsfc(:,:) - - filename = trim(dirpath)//trim(filename_base)//trim(cdate0)//'.nc' - - rc = ESMF_SUCCESS - - call ESMF_LogWrite(trim(tag)//" AtmGridSetUp routine started", ESMF_LOGMSG_INFO) - write(msgString,*)'using grid file : ',trim(filename) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - write(msgString,*)'petCnt = ',petCnt,' lPet = ', lPet - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) -#ifdef test - ! specifying distribution not working; use default distribution - if(petCnt == 1)then - !serial - peList = (/1,1/) - else - if(mod(petCnt,6) .ne. 0)then - write(msgString,*)'must use multiple of 6 PEs; Aborting ' - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - call ESMF_Finalize(endflag = ESMF_END_ABORT) - else - peX = 2*petCnt/3 - peY = petCnt/3 - peList = (/peX, peY/) - allocate(cppeX(1:peX)) - allocate(cppeY(1:peY)) - cppeX(:) = iatm/peX - cppeY(:) = jatm/peY - write(msgString,*)'petCnt = ',petCnt,' peX,peY = ',peX,peY - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - endif - endif -#endif - !------------------------------------------------------------------------------------- - ! read Gaussian coords from file. Native EMSF_ArrayRead does not read Y coord from - ! file correctly - !------------------------------------------------------------------------------------- - - allocate(coordXc(1:iatm)); allocate(coordXq(1:iatm )) - allocate(coordYc(1:jatm)); allocate(coordYq(1:jatm+1)) - - call ReadCoordFromFile(trim(filename),trim('lon'),iatm,coordXc) - call ReadCoordFromFile(trim(filename),trim('lat'),jatm,coordYc) - - write(msgString,*)'coordXc, ',lPet,minval(real(coordXc,4)), & - maxval(real(coordXc,4)) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - write(msgString,*)'coordYc, ',lPet,minval(real(coordYc,4)), & - maxval(real(coordYc,4)) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - - ! create corner points; npole at j=1, spole at j=jatm+1 - j = 1 - coordYq(j) = 90.0_ESMF_KIND_R8 - j = jatm+1 - coordYq(j) = -90.0_ESMF_KIND_R8 - do j = 2,jatm - coordYq(j) = (coordYc(j-1) + coordYc(j))*0.5_ESMF_KIND_R8 - enddo - - ! like module_CPLFIELDS.F90 in GSM - do i = 1,iatm - coordXq(i) = 360.0_ESMF_KIND_R8/real(iatm) * (real(i) - 1.5_ESMF_KIND_R8) - enddo - - write(msgString,*)'coordXq, ',lPet,minval(real(coordXq,4)), & - maxval(real(coordXq,4)) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - write(msgString,*)'coordYq, ',lPet,minval(real(coordYq,4)), & - maxval(real(coordYq,4)) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - - !------------------------------------------------------------------------------------- - ! ESMF_ArrayRead can read the mask from the file, but it is the wrong type (r4) and - ! so requires working around that. Easier to just get global mask array like for the - ! coords - !------------------------------------------------------------------------------------- - - allocate(landsfc(1:iatm,1:jatm)) - call ReadMaskFromFile(trim(filename), trim('slmsksfc'), landsfc) - - !------------------------------------------------------------------------------------- - ! Create the gaussian grid and fill the coords and mask - ! for now, this defaults to the default distribution where the first dimension is - ! decomposed with all PEs - !------------------------------------------------------------------------------------- - grid = ESMF_GridCreate1PeriDim(maxIndex = (/iatm,jatm/), & - ! regDecomp = peList, & - coordDep1=(/1,2/), & ! grid is defined with 2d - coordDep2=(/1,2/), & ! lat,lon arrays - periodicDim=1,& - poleDim=2,& - polekindflag=(/ESMF_POLEKIND_MONOPOLE, & - ESMF_POLEKIND_MONOPOLE/), & - indexflag=AtmIndexType, & - name=trim(gridname), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_GridGet(grid, localDECount=localDECount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - write(msgString,*)'localDECount ',lPet,localDECount - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - !------------------------------------------------------------------------------------- - ! Allocate storage for coords and mask - !------------------------------------------------------------------------------------- - ! P (Center) stagger - call ESMF_GridAddCoord(grid, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! Q (Corner) stagger - call ESMF_GridAddCoord(grid, & - staggerloc=ESMF_STAGGERLOC_CORNER, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! Mask - call ESMF_GridAddItem(grid, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - itemFlag=ESMF_GRIDITEM_MASK, & - itemTypeKind=ESMF_TYPEKIND_I4, & - rc = rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - !------------------------------------------------------------------------------------- - ! Add coords - !------------------------------------------------------------------------------------- - - call AddCoord2Grid(grid, ESMF_STAGGERLOC_CENTER, iatm, jatm , coordXc, coordYc, rc) - call AddCoord2Grid(grid, ESMF_STAGGERLOC_CORNER, iatm, jatm+1, coordXq, coordYq, rc) - - !------------------------------------------------------------------------------------- - ! Add mask - !------------------------------------------------------------------------------------- - - do lde = 0,localDECount-1 - - ! retrieve a pointer for the mask - call ESMF_GridGetItem(grid, localDE=lde,& - staggerloc=ESMF_STAGGERLOC_CENTER, & - itemFlag=ESMF_GRIDITEM_MASK, & - farrayPtr=i4Ptr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !fill the value using the landsfc mask - i4Ptr = 0 - do j = lbound(i4Ptr,2),ubound(i4Ptr,2) - do i = lbound(i4Ptr,1),ubound(i4Ptr,1) - if(landsfc(i,j) .eq. 1.0)i4Ptr(i,j) = int(landsfc(i,j)) - enddo - enddo - - ! get an array from the grid to set the mask - call ESMF_GridGetItem(grid, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - itemFlag=ESMF_GRIDITEM_MASK, & - array=array2d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! a pointer to the array on this DE - call ESMF_ArrayGet(array2d, farrayPtr=i4Ptr, localDE=lde, rc = rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! Set the mask value in the grid - call ESMF_GridSetItem(grid, & - itemFlag=ESMF_GRIDITEM_MASK, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - array=array2d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - enddo !lde - !------------------------------------------------------------------------------------- - ! Write coords and mask to file - !------------------------------------------------------------------------------------- - - call WriteCoord(grid, ESMF_STAGGERLOC_CENTER, 1, 'atmlonc', lPet, rc) - call WriteCoord(grid, ESMF_STAGGERLOC_CENTER, 2, 'atmlatc', lPet, rc) - call WriteCoord(grid, ESMF_STAGGERLOC_CORNER, 1, 'atmlonq', lPet, rc) - call WriteCoord(grid, ESMF_STAGGERLOC_CORNER, 2, 'atmlatq', lPet, rc) - - call WriteMask(grid, ESMF_STAGGERLOC_CENTER, 'atmmask', lPet, rc) - - deallocate(coordXc); deallocate(coordXq) - deallocate(coordYc); deallocate(coordYq) - deallocate(landsfc) - - !deallocate(cppeX); deallocate(cppeY) - call ESMF_LogWrite("User AtmGridSetUp routine ended", ESMF_LOGMSG_INFO) - -end subroutine AtmGridSetUp diff --git a/DATM/AtmGridUtils.F90 b/DATM/AtmGridUtils.F90 index 89b64f1..d985346 100644 --- a/DATM/AtmGridUtils.F90 +++ b/DATM/AtmGridUtils.F90 @@ -5,192 +5,19 @@ module AtmGridUtils !----------------------------------------------------------------------------- use ESMF + use AtmInternalFields, only : ChkErr implicit none private ! called by AtmGridSetUp - public :: ReadCoordFromFile, ReadMaskFromFile - public :: AddCoord2Grid, WriteCoord, WriteMask + public :: WriteCoord, WriteMask - contains - - !------------------------------------------------------------------------------------- - - subroutine ReadCoordFromFile(filename,coordname,coorddim,coordarray) - - use netcdf - - character(len=*), intent(in) :: filename, coordname - integer, intent(in) :: coorddim - - real(kind=ESMF_KIND_R8), intent(out) :: coordarray(coorddim) + character(len=*),parameter :: u_FILE_u = & + __FILE__ - real(kind=ESMF_KIND_R4) :: coordR4(coorddim) - - integer :: ncid, varid, rc - - rc = nf90_open(trim(filename), nf90_nowrite, ncid) - if(rc .ne. 0)then - call ESMF_LogWrite(trim(filename)//' not found!', ESMF_LOGMSG_INFO, rc=rc) - call ESMF_Finalize(endflag=ESMF_END_ABORT) - end if - - rc = nf90_inq_varid(ncid, trim(coordname), varid) - rc = nf90_get_var(ncid, varid, coordR4) - rc = nf90_close(ncid) - - coordarray = real(coordR4,8) - - end subroutine ReadCoordFromFile - - !------------------------------------------------------------------------------------- - - subroutine ReadMaskFromFile(filename,maskname,maskarray) - - use netcdf - use AtmInternalFields, only : iatm, jatm - - character(len=*), intent(in) :: filename, maskname - - real(kind=ESMF_KIND_R4), intent(out) :: maskarray(iatm,jatm) - - integer :: ncid, varid, rc - - rc = nf90_open(trim(filename), nf90_nowrite, ncid) - if(rc .ne. 0)then - call ESMF_LogWrite(trim(filename)//' not found!', ESMF_LOGMSG_INFO, rc=rc) - call ESMF_Finalize(endflag=ESMF_END_ABORT) - end if - - rc = nf90_inq_varid(ncid, trim(maskname), varid) - rc = nf90_get_var(ncid, varid, maskarray) - rc = nf90_close(ncid) - - end subroutine ReadMaskFromFile - - !------------------------------------------------------------------------------------- - - subroutine AddCoord2Grid(grid,stagger,imax,jmax,coordX,coordY,rc) - - type(ESMF_Grid) :: grid - type(ESMF_Array) :: array2d - type(ESMF_StaggerLoc) :: stagger - - integer, intent(in) :: imax, jmax - real(kind=ESMF_KIND_R8), intent(in) :: coordX(imax) - real(kind=ESMF_KIND_R8), intent(in) :: coordY(jmax) - - integer, intent(out) :: rc - - integer :: i,j,lde,localDECount - real(kind=ESMF_KIND_R8), pointer :: r8Ptr(:,:) - character(len=ESMF_MAXSTR) :: msgString - - - ! Initialize return code - rc = ESMF_SUCCESS - - call ESMF_GridGet(grid, localDECount=localDECount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - do lde = 0,localDECount-1 - - ! Retrieve a pointer to the first coord - call ESMF_GridGetCoord(grid, localDE=lde,& - coordDim=1, & - staggerloc=stagger, & - farrayPtr=r8Ptr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! fill the values from the coordX farray - do j = lbound(r8Ptr,2),ubound(r8Ptr,2) - do i = lbound(r8Ptr,1),ubound(r8Ptr,1) - r8Ptr(i,j) = coordX(i) - enddo - enddo - - ! get an array from the grid to set the coord in the grid - call ESMF_GridGetCoord(grid, & - coordDim=1, & - staggerloc=stagger, & - array=array2d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! a pointer to the array on this DE - call ESMF_ArrayGet(array2d, farrayPtr=r8Ptr, localDE=lde, rc = rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! Set the first coord in the grid - call ESMF_GridSetCoord(grid, & - coordDim=1, & - staggerloc=stagger, & - array=array2d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! Retrieve a pointer to the second coord - call ESMF_GridGetCoord(grid, localDE=lde,& - coordDim=2, & - staggerloc=stagger, & - farrayPtr=r8Ptr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! fill the values from the coordY farray - do j = lbound(r8Ptr,2),ubound(r8Ptr,2) - do i = lbound(r8Ptr,1),ubound(r8Ptr,1) - r8Ptr(i,j) = coordY(j) - enddo - enddo - - ! get an array from the grid to set the coord in the grid - call ESMF_GridGetCoord(grid, & - coordDim=2, & - staggerloc=stagger, & - array=array2d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! a pointer to the array on this DE - call ESMF_ArrayGet(array2d, farrayPtr=r8Ptr, localDE=lde, rc = rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! Set the second coord in the grid - call ESMF_GridSetCoord(grid, & - coordDim=2, & - staggerloc=stagger, & - array=array2d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - enddo !lde - - end subroutine AddCoord2Grid + contains !------------------------------------------------------------------------------------- @@ -219,18 +46,12 @@ subroutine WriteCoord(grid,stagger,dimnum,fname,lPet,rc) coordDim=dimnum, & staggerloc=stagger, & array=array2d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! a pointer to the array !call ESMF_ArrayGet(array2d, farrayPtr=r8Ptr, localDe=0, rc = rc) call ESMF_ArrayGet(array2d, farrayPtr=r8Ptr, rc = rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! verify values write(msgString,*)'r8Ptr ',trim(fname),' lPet', & @@ -238,7 +59,7 @@ subroutine WriteCoord(grid,stagger,dimnum,fname,lPet,rc) lbound(r8Ptr,2),ubound(r8Ptr,2), & minval(real(r8Ptr,4)), & maxval(real(r8Ptr,4)) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) ! write to a file varname = trim(fname); filename = trim(varname)//'.nc' @@ -246,10 +67,7 @@ subroutine WriteCoord(grid,stagger,dimnum,fname,lPet,rc) fileName=filename, & variableName=varname, & overwrite=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine WriteCoord @@ -282,18 +100,12 @@ subroutine WriteMask(grid,stagger,fname,lPet,rc) itemFlag=ESMF_GRIDITEM_MASK, & staggerloc=ESMF_STAGGERLOC_CENTER, & array=array2d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return !a pointer to the mask !call ESMF_ArrayGet(array2d, farrayPtr=i4Ptr, localDE=0, rc = rc) call ESMF_ArrayGet(array2d, farrayPtr=i4Ptr, rc = rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! verify values write(msgString,*)'i4Ptr ',trim(fname),' lPet', & @@ -301,7 +113,7 @@ subroutine WriteMask(grid,stagger,fname,lPet,rc) lbound(i4Ptr,2),ubound(i4Ptr,2), & minval(i4Ptr), & maxval(i4Ptr) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) ! write to a file varname = trim(fname); filename = trim(varname)//'.nc' @@ -309,10 +121,7 @@ subroutine WriteMask(grid,stagger,fname,lPet,rc) fileName=filename, & variableName=varname, & overwrite=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine WriteMask end module AtmGridUtils diff --git a/DATM/AtmImportFields.F90 b/DATM/AtmImportFields.F90 deleted file mode 100644 index 7218bf3..0000000 --- a/DATM/AtmImportFields.F90 +++ /dev/null @@ -1,67 +0,0 @@ -module AtmImportFields - -#include "LocalDefs.F90" - -#ifdef coupled -! when run w/ Mediator as component in coupled app, at least -! one import field seems to be required - use ESMF - use AtmInternalFields, only : AtmField_Definition - - implicit none - - private - - type(AtmField_Definition), public :: AtmFieldsToImport(1) - - !----------------------------------------------------------------------------- - ! Fortran array pointers - ! Fields for DAtm model - ! in Atm importState - !----------------------------------------------------------------------------- - real(kind=ESMF_KIND_R8), dimension(:,:), public, pointer :: land_mask - - ! called by Cap - public :: AtmImportFieldsSetUp - - contains - - !----------------------------------------------------------------------------- - - subroutine AtmImportFieldsSetUp - - integer :: ii - character(len=ESMF_MAXSTR) :: msgString - - ! default values - AtmFieldsToImport(:)%staggertype = 'center' - - ii = 0 - !----------------------------------------------------------------------------- - !Atm Import Fields (req by Mediator ?) - !----------------------------------------------------------------------------- - - ii = ii + 1 - AtmFieldsToImport(ii)%standard_name = 'land_mask' - AtmFieldsToImport(ii)%field_name = 'LandMask' - AtmFieldsToImport(ii)%file_varname = 'slmsksfc' - AtmFieldsToImport(ii)%unit_name = '1' - AtmFieldsToImport(ii)%farrayPtr => land_mask - - !----------------------------------------------------------------------------- - ! check - !----------------------------------------------------------------------------- - if(ii .ne. size(AtmFieldsToImport)) & - call ESMF_LogWrite("ERROR: check # AtmFieldsToImport", ESMF_LOGMSG_INFO) - - call ESMF_LogWrite('AtmFieldsToImport : ', ESMF_LOGMSG_INFO) - do ii = 1,size(AtmFieldsToImport) - write(msgString,'(i6,2(a2,a14),a2,a)')ii,' ',trim(AtmFieldsToImport(ii)%file_varname), & - ' ',trim(AtmFieldsToImport(ii)%field_name), & - ' ',trim(AtmFieldsToImport(ii)%standard_name) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - enddo - - end subroutine AtmImportFieldsSetUp -#endif -end module AtmImportFields diff --git a/DATM/AtmInternalFields.F90 b/DATM/AtmInternalFields.F90 index 5de41d4..c10f70a 100644 --- a/DATM/AtmInternalFields.F90 +++ b/DATM/AtmInternalFields.F90 @@ -6,6 +6,11 @@ module AtmInternalFields implicit none + public :: ChkErr + + character(len=*),parameter :: u_FILE_u = & + __FILE__ + private !from model_configure @@ -28,14 +33,17 @@ module AtmInternalFields ! and the file_varname is the name of the variable in the source file type, public :: AtmField_Definition character(len=64) :: standard_name + character(len=64) :: shortname character(len=12) :: field_name character(len=12) :: file_varname character(len=12) :: unit_name character(len=10) :: staggertype logical :: isPresent - real(kind=ESMF_KIND_R8), dimension(:,:), pointer :: farrayPtr => null() - real(kind=ESMF_KIND_R4), dimension(:,:), pointer :: farrayPtr_bak => null() - real(kind=ESMF_KIND_R4), dimension(:,:), pointer :: farrayPtr_fwd => null() + ! for export + real(kind=ESMF_KIND_R8), dimension(:,:), pointer :: farrayPtr + ! for forcing data, two time levels + real(kind=ESMF_KIND_R4), dimension(:,:), pointer :: farrayPtr_bak + real(kind=ESMF_KIND_R4), dimension(:,:), pointer :: farrayPtr_fwd end type AtmField_Definition ! Field Bundles for Atm model used for time-interpolation of forcing @@ -44,6 +52,7 @@ module AtmInternalFields integer, parameter, public :: AtmFieldCount = 6 & !height lowest + 3 & !swd,lwd,lwup + + 1 & !net lw + 4 & !momentum,sens,lat + 4 & !vis,ir,dir,dif + 3 !ps,prec @@ -84,6 +93,8 @@ subroutine AtmBundleSetUp AtmBundleFields(:)%staggertype = 'center' ! field availability will be set using data_table.IN !AtmBundleFields(:)%isPresent = .true. + ! used to set the field name in the exportState = standard_name + AtmBundleFields(:)%shortname = ' ' ii = 0 !----------------------------------------------------------------------------- @@ -91,20 +102,22 @@ subroutine AtmBundleSetUp !----------------------------------------------------------------------------- ii = ii + 1 - AtmBundleFields(ii)%standard_name = 'mean_zonal_moment_flx' + AtmBundleFields(ii)%standard_name = 'mean_zonal_moment_flx_atm' AtmBundleFields(ii)%field_name = 'Dusfc' AtmBundleFields(ii)%file_varname = 'dusfc' AtmBundleFields(ii)%unit_name = 'N/m2' AtmBundleFields(ii)%farrayPtr_bak => null() AtmBundleFields(ii)%farrayPtr_fwd => null() + AtmBundleFields(ii)%farrayPtr => null() ii = ii + 1 - AtmBundleFields(ii)%standard_name = 'mean_merid_moment_flx' + AtmBundleFields(ii)%standard_name = 'mean_merid_moment_flx_atm' AtmBundleFields(ii)%field_name = 'Dvsfc' AtmBundleFields(ii)%file_varname = 'dvsfc' AtmBundleFields(ii)%unit_name = 'N/m2' AtmBundleFields(ii)%farrayPtr_bak => null() AtmBundleFields(ii)%farrayPtr_fwd => null() + AtmBundleFields(ii)%farrayPtr => null() !----------------------------------------------------------------------------- ! @@ -117,6 +130,7 @@ subroutine AtmBundleSetUp AtmBundleFields(ii)%unit_name = 'K' AtmBundleFields(ii)%farrayPtr_bak => null() AtmBundleFields(ii)%farrayPtr_fwd => null() + AtmBundleFields(ii)%farrayPtr => null() ii = ii + 1 AtmBundleFields(ii)%standard_name = 'inst_temp_height_lowest' @@ -125,6 +139,7 @@ subroutine AtmBundleSetUp AtmBundleFields(ii)%unit_name = 'K' AtmBundleFields(ii)%farrayPtr_bak => null() AtmBundleFields(ii)%farrayPtr_fwd => null() + AtmBundleFields(ii)%farrayPtr => null() ii = ii + 1 AtmBundleFields(ii)%standard_name = 'inst_spec_humid_height_lowest' @@ -133,6 +148,7 @@ subroutine AtmBundleSetUp AtmBundleFields(ii)%unit_name = 'kg/kg' AtmBundleFields(ii)%farrayPtr_bak => null() AtmBundleFields(ii)%farrayPtr_fwd => null() + AtmBundleFields(ii)%farrayPtr => null() ii = ii + 1 AtmBundleFields(ii)%standard_name = 'inst_zonal_wind_height_lowest' @@ -141,6 +157,7 @@ subroutine AtmBundleSetUp AtmBundleFields(ii)%unit_name = 'm/s' AtmBundleFields(ii)%farrayPtr_bak => null() AtmBundleFields(ii)%farrayPtr_fwd => null() + AtmBundleFields(ii)%farrayPtr => null() ii = ii + 1 AtmBundleFields(ii)%standard_name = 'inst_merid_wind_height_lowest' @@ -149,6 +166,7 @@ subroutine AtmBundleSetUp AtmBundleFields(ii)%unit_name = 'm/s' AtmBundleFields(ii)%farrayPtr_bak => null() AtmBundleFields(ii)%farrayPtr_fwd => null() + AtmBundleFields(ii)%farrayPtr => null() ii = ii + 1 AtmBundleFields(ii)%standard_name = 'inst_pres_height_lowest' @@ -157,6 +175,7 @@ subroutine AtmBundleSetUp AtmBundleFields(ii)%unit_name = 'Pa' AtmBundleFields(ii)%farrayPtr_bak => null() AtmBundleFields(ii)%farrayPtr_fwd => null() + AtmBundleFields(ii)%farrayPtr => null() !----------------------------------------------------------------------------- ! @@ -169,6 +188,7 @@ subroutine AtmBundleSetUp AtmBundleFields(ii)%unit_name = 'W/m2' AtmBundleFields(ii)%farrayPtr_bak => null() AtmBundleFields(ii)%farrayPtr_fwd => null() + AtmBundleFields(ii)%farrayPtr => null() ii = ii + 1 AtmBundleFields(ii)%standard_name = 'mean_down_lw_flx' @@ -177,6 +197,7 @@ subroutine AtmBundleSetUp AtmBundleFields(ii)%unit_name = 'W/m2' AtmBundleFields(ii)%farrayPtr_bak => null() AtmBundleFields(ii)%farrayPtr_fwd => null() + AtmBundleFields(ii)%farrayPtr => null() ii = ii + 1 AtmBundleFields(ii)%standard_name = 'mean_up_lw_flx' @@ -185,6 +206,17 @@ subroutine AtmBundleSetUp AtmBundleFields(ii)%unit_name = 'W/m2' AtmBundleFields(ii)%farrayPtr_bak => null() AtmBundleFields(ii)%farrayPtr_fwd => null() + AtmBundleFields(ii)%farrayPtr => null() + + ! created from DLWRF-ULWRF in AtmForce + ii = ii + 1 + AtmBundleFields(ii)%standard_name = 'mean_net_lw_flx' + AtmBundleFields(ii)%field_name = 'Nlwrf' + AtmBundleFields(ii)%file_varname = ' ' + AtmBundleFields(ii)%unit_name = 'W/m2' + AtmBundleFields(ii)%farrayPtr_bak => null() + AtmBundleFields(ii)%farrayPtr_fwd => null() + AtmBundleFields(ii)%farrayPtr => null() !----------------------------------------------------------------------------- ! @@ -197,6 +229,7 @@ subroutine AtmBundleSetUp AtmBundleFields(ii)%unit_name = 'W/m2' AtmBundleFields(ii)%farrayPtr_bak => null() AtmBundleFields(ii)%farrayPtr_fwd => null() + AtmBundleFields(ii)%farrayPtr => null() ii = ii + 1 AtmBundleFields(ii)%standard_name = 'mean_laten_heat_flx' @@ -205,6 +238,7 @@ subroutine AtmBundleSetUp AtmBundleFields(ii)%unit_name = 'W/m2' AtmBundleFields(ii)%farrayPtr_bak => null() AtmBundleFields(ii)%farrayPtr_fwd => null() + AtmBundleFields(ii)%farrayPtr => null() !----------------------------------------------------------------------------- ! @@ -217,6 +251,7 @@ subroutine AtmBundleSetUp AtmBundleFields(ii)%unit_name = 'W/m2' AtmBundleFields(ii)%farrayPtr_bak => null() AtmBundleFields(ii)%farrayPtr_fwd => null() + AtmBundleFields(ii)%farrayPtr => null() ii = ii + 1 AtmBundleFields(ii)%standard_name = 'mean_down_sw_vis_dif_flx' @@ -225,6 +260,7 @@ subroutine AtmBundleSetUp AtmBundleFields(ii)%unit_name = 'W/m2' AtmBundleFields(ii)%farrayPtr_bak => null() AtmBundleFields(ii)%farrayPtr_fwd => null() + AtmBundleFields(ii)%farrayPtr => null() ii = ii + 1 AtmBundleFields(ii)%standard_name = 'mean_down_sw_ir_dir_flx' @@ -233,6 +269,7 @@ subroutine AtmBundleSetUp AtmBundleFields(ii)%unit_name = 'W/m2' AtmBundleFields(ii)%farrayPtr_bak => null() AtmBundleFields(ii)%farrayPtr_fwd => null() + AtmBundleFields(ii)%farrayPtr => null() ii = ii + 1 AtmBundleFields(ii)%standard_name = 'mean_down_sw_ir_dif_flx' @@ -241,6 +278,7 @@ subroutine AtmBundleSetUp AtmBundleFields(ii)%unit_name = 'W/m2' AtmBundleFields(ii)%farrayPtr_bak => null() AtmBundleFields(ii)%farrayPtr_fwd => null() + AtmBundleFields(ii)%farrayPtr => null() !----------------------------------------------------------------------------- ! @@ -253,6 +291,7 @@ subroutine AtmBundleSetUp AtmBundleFields(ii)%unit_name = 'Pa' AtmBundleFields(ii)%farrayPtr_bak => null() AtmBundleFields(ii)%farrayPtr_fwd => null() + AtmBundleFields(ii)%farrayPtr => null() ii = ii + 1 AtmBundleFields(ii)%standard_name = 'mean_prec_rate' @@ -261,6 +300,7 @@ subroutine AtmBundleSetUp AtmBundleFields(ii)%unit_name = 'kg/m2/s' AtmBundleFields(ii)%farrayPtr_bak => null() AtmBundleFields(ii)%farrayPtr_fwd => null() + AtmBundleFields(ii)%farrayPtr => null() ii = ii + 1 AtmBundleFields(ii)%standard_name = 'mean_fprec_rate' @@ -269,6 +309,7 @@ subroutine AtmBundleSetUp AtmBundleFields(ii)%unit_name = 'kg/m2/s' AtmBundleFields(ii)%farrayPtr_bak => null() AtmBundleFields(ii)%farrayPtr_fwd => null() + AtmBundleFields(ii)%farrayPtr => null() if(ii .ne. size(AtmBundleFields)) & call ESMF_LogWrite("ERROR: check # AtmBundleFields", ESMF_LOGMSG_INFO) @@ -278,26 +319,17 @@ subroutine AtmBundleSetUp !----------------------------------------------------------------------------- cfdata=ESMF_ConfigCreate(rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ConfigLoadFile(config=cfdata ,filename='datm_data_table' ,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return nfields = size(AtmBundleFields) do ii = 1,nfields call ESMF_ConfigGetAttribute(config=cfdata, & value=lvalue, & label=trim(AtmBundleFields(ii)%standard_name),rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return AtmBundleFields(ii)%isPresent=lvalue enddo @@ -316,4 +348,17 @@ subroutine AtmBundleSetUp enddo end subroutine AtmBundleSetUp + + logical function ChkErr(rc, line, file) + integer, intent(in) :: rc + integer, intent(in) :: line + character(len=*), intent(in) :: file + integer :: lrc + chkerr = .false. + lrc = rc + if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then + chkerr = .true. + endif + end function ChkErr + end module AtmInternalFields diff --git a/DATM/AtmModel.F90 b/DATM/AtmModel.F90 index b35db87..87d1a32 100644 --- a/DATM/AtmModel.F90 +++ b/DATM/AtmModel.F90 @@ -3,13 +3,10 @@ module AtmModel #include "LocalDefs.F90" use ESMF - !use AtmInternalFields, only : atmlonc, atmlatc, atmlonq, atmlatq + use AtmInternalFields, only : ChkErr use AtmInternalFields, only : hfwd, hbak, nfhout use AtmFieldUtils, only : AtmForceFwd2Bak, AtmBundleCheck use AtmFieldUtils, only : AtmBundleIntp -#ifdef coupled - use AtmImportFields, only : land_mask -#endif implicit none @@ -18,6 +15,9 @@ module AtmModel ! called by Cap public :: AtmInit, AtmRun, AtmFinal + character(len=*),parameter :: u_FILE_u = & + __FILE__ + contains subroutine AtmInit(gcomp, importState, exportState, externalClock, rc) @@ -46,10 +46,7 @@ subroutine AtmInit(gcomp, importState, exportState, externalClock, rc) ! Get the Grid call ESMF_GridCompGet(gcomp, grid=grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Get the mask from the grid !call ESMF_GridGetItem(grid, & @@ -58,18 +55,12 @@ subroutine AtmInit(gcomp, importState, exportState, externalClock, rc) call ESMF_GridGetItem(grid, & itemFlag=ESMF_GRIDITEM_MASK, & array=array2d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return !a pointer to the mask !call ESMF_ArrayGet(array2d, farrayPtr=i4Ptr, localDE=0, rc = rc) call ESMF_ArrayGet(array2d, farrayPtr=i4Ptr, rc = rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return lbnd1 = lbound(i4Ptr,1); ubnd1 = ubound(i4Ptr,1) lbnd2 = lbound(i4Ptr,2); ubnd2 = ubound(i4Ptr,2) @@ -79,37 +70,6 @@ subroutine AtmInit(gcomp, importState, exportState, externalClock, rc) write(msgString,*)'AtmInit: print at ',iprnt,jprnt,& i4Ptr(iprnt,jprnt) call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) -#ifdef test - ! The land_mask import array from the grid mask - call ESMF_StateGet(importState, & - itemName=trim('LandMask'), & - field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_FieldGet(field,farrayPtr=land_mask,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - do j = lbound(i4Ptr,2),ubound(i4Ptr,2) - do i = lbound(i4Ptr,1),ubound(i4Ptr,1) - land_mask(i,j) = real(i4Ptr(i,j),8) - enddo - enddo -#endif - ! Set up the fields in the AtmBundle - call AtmBundleSetUp - - ! Create and fill the AtmBundle - call AtmBundleCreate(gcomp, importState, exportState, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out ! initialize the fwd and bak fields as special case at initialzation call AtmForce(gcomp,exportState,externalClock,0,rc) diff --git a/DATM/Makefile b/DATM/Makefile index 5aca66f..bee6525 100644 --- a/DATM/Makefile +++ b/DATM/Makefile @@ -53,17 +53,15 @@ nuopc: datm.mk nuopcinstall: install # ------------------------------------------------------------------------------ -AtmOBJS=datm.o AtmInternalFields.o AtmExportFields.o AtmImportFields.o AtmFieldUtils.o AtmGridUtils.o AtmForce.o AtmGridSetUp.o AtmModel.o LocalDefs.o AtmBundleCreate.o +AtmOBJS=datm.o AtmInternalFields.o AtmFieldUtils.o AtmForce.o AtmModel.o LocalDefs.o AtmBundleCreate.o AtmGridUtils.o datm.o: $(AtmOBJS) -datm.o: AtmExportFields.o AtmModel.o AtmFieldUtils.o +datm.o: AtmModel.o AtmFieldUtils.o AtmGridUtils.o AtmModel.o: AtmFieldUtils.o -AtmForce.o: AtmExportFields.o -AtmGridSetUp.o: AtmExportFields.o AtmGridUtils.o +AtmForce.o: AtmInternalFields.o AtmBundleCreate.o : AtmInternalFields.o -AtmFieldUtils.o : AtmInternalFields.o AtmImportFields.o AtmExportFields.o -AtmImportFields.o : AtmInternalFields.o +AtmFieldUtils.o : AtmInternalFields.o AtmExportFields.o : AtmInternalFields.o # ----------------------------------------------------------------------------- .PRECIOUS: %.o diff --git a/DATM/datm.F90 b/DATM/datm.F90 index 16af322..c54bc9b 100644 --- a/DATM/datm.F90 +++ b/DATM/datm.F90 @@ -11,24 +11,17 @@ module DAtm use NUOPC_Model, & model_routine_SS => SetServices, & model_label_SetRunClock => label_SetRunClock, & - model_label_CheckImport => label_CheckImport, & model_label_Advance => label_Advance ! Fields exported by Atm - use AtmExportFields, only : AtmExportFieldsSetUp, AtmFieldsToExport -#ifdef coupled - ! Fields imported by Atm - use AtmImportFields, only : AtmImportFieldsSetUp, AtmFieldsToImport -#endif use AtmFieldUtils, only : AtmFieldsAdvertise, AtmFieldsRealize use AtmFieldUtils, only : AtmFieldDump use AtmFieldUtils, only : AtmFieldCheck + use AtmGridUtils, only : WriteCoord, WriteMask ! AtmInit called by InitializeP2, AtmRun called by ModelAdvance use AtmModel, only : AtmInit, AtmRun, AtmFinal - - use AtmInternalFields, only : lPet, petCnt, dt_atmos, iatm, jatm, nfhout - use AtmInternalFields, only : dirpath, cdate0, filename_base + use AtmInternalFields implicit none @@ -43,6 +36,9 @@ module DAtm logical, public :: dumpfields = .true. logical, public :: profile_memory = .false. + character(len=*),parameter :: u_FILE_u = & + __FILE__ + contains subroutine SetServices(model, rc) @@ -54,10 +50,7 @@ subroutine SetServices(model, rc) ! the NUOPC model component will register the generic methods call NUOPC_CompDerive(model, model_routine_SS, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! set entry point for methods that require specific implementation @@ -66,78 +59,42 @@ subroutine SetServices(model, rc) ESMF_METHOD_INITIALIZE, & userRoutine=InitializeP0, & phase=0, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Advertise Fields call NUOPC_CompSetEntryPoint(model, & ESMF_METHOD_INITIALIZE, & phaseLabelList=(/"IPDv02p1"/), & userRoutine=InitializeP1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Realize Fields call NUOPC_CompSetEntryPoint(model, & ESMF_METHOD_INITIALIZE, & phaseLabelList=(/"IPDv02p2"/), & userRoutine=InitializeP2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! specialize label_SetRunClock which ensures the correct timeStep ! is set during the run cycle ! -> NUOPC specializes by default --->>> first need to remove the default call ESMF_MethodRemove(model, model_label_SetRunClock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(model, & specLabel=model_label_SetRunClock, & specRoutine=SetRunClock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! overwrite default CheckImport method - ! if not overwritten, checkimport verifies that all import fields are at the current - ! time of internal clock - call ESMF_MethodRemove(model, label=model_label_CheckImport, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call NUOPC_CompSpecialize(model, specLabel=model_label_CheckImport, & - specRoutine=CheckImport, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(model, & specLabel=model_label_Advance, & specRoutine=ModelAdvance, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! overwrite Finalize call ESMF_GridCompSetEntryPoint(model, ESMF_METHOD_FINALIZE, & userRoutine=AtmFinal, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_GridCompGet(model, vm=vm, rc=rc) call ESMF_VMGet(vm,petCount=petCnt,localPet=lPet,rc=rc) @@ -166,10 +123,7 @@ subroutine InitializeP0(model, importState, exportState, externalClock, rc) acceptStringList=(/"IPDv02"/), & !acceptStringList=(/"IPDv04"/), & rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return #ifdef coupled ! Use attributes call ESMF_AttributeGet(model, & @@ -177,27 +131,21 @@ subroutine InitializeP0(model, importState, exportState, externalClock, rc) value=value, & defaultValue="true", & convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return coldstart=(trim(value)=="true") write(msgString,'(A,l6)')'DATM ColdStart = ',coldstart - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) call ESMF_AttributeGet(model, & name="DumpFields", & value=value, & defaultValue="true", & convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return dumpfields=(trim(value)=="true") write(msgString,'(A,l6)')'DATM Dumpfields = ',dumpfields - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) !like module_MEDIATOR call ESMF_AttributeGet(model, & @@ -205,20 +153,11 @@ subroutine InitializeP0(model, importState, exportState, externalClock, rc) value=value, & defaultValue="true", & convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return profile_memory=(trim(value)/="false") write(msgString,'(A,l6)')'DATM Profile_memory = ',profile_memory - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) -#endif - - ! set up the field atts for the Atm component - call AtmExportFieldsSetUp -#ifdef coupled - call AtmImportFieldsSetUp + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) #endif call ESMF_LogWrite("User initialize routine InitP0 Atm finished", ESMF_LOGMSG_INFO) @@ -243,18 +182,12 @@ subroutine InitializeP1(model, importState, exportState, externalClock, rc) call ESMF_LogWrite("User initialize routine InitP1 Atm started", ESMF_LOGMSG_INFO) - call AtmFieldsAdvertise(exportState, AtmFieldsToExport, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out -#ifdef coupled - call AtmFieldsAdvertise(importState, AtmFieldsToImport, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out -#endif + ! Set up the fields in the AtmBundle + call AtmBundleSetUp + + call AtmFieldsAdvertise(exportState, AtmBundleFields, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + !----------------------------------------------------------------------------- ! get config variables, like fv3_cap ! ? could also get npx,npy (npx*npy=nprocs) to set decomposition @@ -262,84 +195,60 @@ subroutine InitializeP1(model, importState, exportState, externalClock, rc) cf=ESMF_ConfigCreate(rc=rc) call ESMF_ConfigLoadFile(config=cf ,filename='model_configure' ,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ConfigGetAttribute(config=cf, & value=iatm, & label='iatm:',rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return write(msgString,'(a,i6)')'Model configure found with iatm = ',iatm - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO) call ESMF_ConfigGetAttribute(config=cf, & value=jatm, & label='jatm:',rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return write(msgString,'(a,i6)')'Model configure found with jatm = ',jatm - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO) call ESMF_ConfigGetAttribute(config=cf, & value=cdate0, & label='cdate0:',rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return write(msgString,'(a,a)')'Model configure found with cdate0 = ',trim(cdate0) - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO) call ESMF_ConfigGetAttribute(config=cf, & value=nfhout, & label='nfhout:',rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return write(msgString,'(a,i6)')'Model configure found with nfhout = ',nfhout - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO) call ESMF_ConfigGetAttribute(config=cf, & value=filename_base, & label='filename_base:',rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return write(msgString,'(a,a)')'Model configure found with filename_base = ', & trim(filename_base) - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO) call ESMF_ConfigGetAttribute(config=cf, & value=dt_atmos, & label='dt_atmos:',rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return write(msgString,'(a,f8.1)')'Model configure found with dt_atmos = ',dt_atmos - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO) call ESMF_ConfigGetAttribute(config=cf, & value=medAtmCouplingIntervalSec, & label="atm_coupling_interval_sec:", & default=-1.0_ESMF_KIND_R8, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return write(msgString,'(a,f8.1)')'Model configure found with atm_coupling_interval_sec = ', & medAtmCouplingIntervalSec - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) call ESMF_LogWrite("User initialize routine InitP1 Atm finished", ESMF_LOGMSG_INFO) @@ -359,6 +268,7 @@ subroutine InitializeP2(model, importState, exportState, externalClock, rc) type(ESMF_Grid) :: gridOut type(ESMF_Field) :: field character(ESMF_MAXSTR) :: msgString + character(ESMF_MAXSTR) :: fname integer :: ii, nfields @@ -369,79 +279,64 @@ subroutine InitializeP2(model, importState, exportState, externalClock, rc) call ESMF_ClockPrint(externalClock, options="currTime", & preString="InitP2 Atm CLOCK_EARTH current: ", & unit=msgString) - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO) call ESMF_ClockPrint(externalClock, options="startTime", & preString="InitP2 Atm CLOCK_EARTH start: ", & unit=msgString) - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO) call ESMF_ClockPrint(externalClock, options="stopTime", & preString="InitP2 Atm CLOCK_EARTH stop: ", & unit=msgString) - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO) - call AtmGridSetUp(gridIn,petCnt,'Atm grid','InitP2 Atm',rc) + fname = trim(dirpath)//trim(filename_base)//'SCRIP.nc' + call ESMF_LogWrite('reading grid file '//trim(fname), ESMF_LOGMSG_INFO) + + gridIn = ESMF_GridCreate(filename=trim(fname),& + fileformat = ESMF_FILEFORMAT_SCRIP, & + addCornerStagger=.true., & + indexflag=AtmIndexType, & + addMask=.true.,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return gridOut = gridIn ! for now out same as in - call AtmFieldsRealize(exportState, gridOut, AtmFieldsToExport, 'Atm Export', rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out -#ifdef coupled - call AtmFieldsRealize(importState, gridOut, AtmFieldsToImport, 'Atm Import', rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out -#endif + ! Write coords and mask to file + call WriteCoord(gridIn, ESMF_STAGGERLOC_CENTER, 1, 'atmlonc', lPet, rc) + call WriteCoord(gridIn, ESMF_STAGGERLOC_CENTER, 2, 'atmlatc', lPet, rc) + call WriteCoord(gridIn, ESMF_STAGGERLOC_CORNER, 1, 'atmlonq', lPet, rc) + call WriteCoord(gridIn, ESMF_STAGGERLOC_CORNER, 2, 'atmlatq', lPet, rc) + + call WriteMask(gridIn, ESMF_STAGGERLOC_CENTER, 'atmmask', lPet, rc) + ! Attach the grid to the Component call ESMF_GridCompSet(model, grid=gridOut, rc=rc) - !call ESMF_GridCompPrint(model, rc=rc) + ! Create and fill the AtmBundle + call AtmBundleCreate(model, importState, exportState, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call AtmFieldsRealize(exportState, gridOut, AtmBundleFields, 'Atm Export', rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call AtmInit(model, importState, exportState, externalClock, rc) ! AtmInit calls AtmForce and loads the values for the first integration ! timestep, so..... ! -> set Updated Field Attribute to "true", indicating to the IPDv02p5 ! generic code to set the timestamp for this Field -#ifdef coupled - nfields = size(AtmFieldsToImport) - do ii = 1,nfields - call ESMF_StateGet(importState, & - field=field, & - itemName=trim(AtmFieldsToImport(ii)%field_name), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call NUOPC_SetAttribute(field, name="Updated", value="true", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_LogWrite(trim(AtmFieldsToImport(ii)%field_name)//' set to Updated', ESMF_LOGMSG_INFO) - enddo !ii -#endif - nfields = size(AtmFieldsToExport) + nfields = size(AtmBundleFields) do ii = 1,nfields call ESMF_StateGet(exportState, & field=field, & - itemName=trim(AtmFieldsToExport(ii)%field_name), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + itemName=trim(AtmBundleFields(ii)%shortname), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_SetAttribute(field, name="Updated", value="true", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(AtmFieldsToExport(ii)%field_name)//' set to Updated', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(AtmBundleFields(ii)%shortname)//' set to Updated', ESMF_LOGMSG_INFO) enddo !ii ! the component needs to indicate that it is fully done with @@ -451,12 +346,11 @@ subroutine InitializeP2(model, importState, exportState, externalClock, rc) call NUOPC_CompAttributeSet(model, & name="InitializeDataComplete", & value="true", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite('Atm InitializeDataComplete', ESMF_LOGMSG_INFO) + call AtmFieldCheck(importState, exportState, 'InitP2 Atm', rc) + call ESMF_LogWrite("User initialize routine InitP2 Atm finished", ESMF_LOGMSG_INFO) end subroutine InitializeP2 @@ -469,30 +363,26 @@ subroutine ModelAdvance(model, rc) integer, intent(out) :: rc ! local variables - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: modelClock - type(ESMF_Time) :: stopTime - type(ESMF_Time) :: startTime - type(ESMF_Time) :: currTime + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: modelClock + type(ESMF_Time) :: stopTime + type(ESMF_Time) :: startTime + type(ESMF_Time) :: currTime + type(ESMF_TimeInterval) :: timeStep character(len=ESMF_MAXSTR) :: msgString - integer :: idumpcnt = 0 + character(len=ESMF_MAXSTR) :: export_timestr rc = ESMF_SUCCESS call ESMF_LogWrite("User routine ModelAdvance Atm started", ESMF_LOGMSG_INFO) - idumpcnt = idumpcnt + 1 - ! query the Component for its clock, importState and exportState call NUOPC_ModelGet(model, & modelClock=modelClock, & importState=importState, & exportState=exportState, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! HERE THE MODEL ADVANCES: currTime -> currTime + timeStep @@ -510,28 +400,26 @@ subroutine ModelAdvance(model, rc) call ESMF_ClockPrint(modelClock, options="currTime", & preString="ModelAdvance DATM with CLOCK current: ", & unit=msgString) - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO) call ESMF_ClockPrint(modelClock, options="stopTime", & preString="ModelAdvance DATM with CLOCK stop: ", & unit=msgString) - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO) + call ESMF_ClockGet(modelClock, currTime=currTime, timeStep=timeStep, rc=rc) + + ! TODO: why is this the export time? + call ESMF_TimeGet(currTime, timestring=export_timestr, rc=rc) ! Run the component call AtmRun(model, importState, exportState, modelClock, rc) ! Check Values call AtmFieldCheck(importState, exportState, 'after AtmRun', rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return if(dumpfields)then - call AtmFieldDump(importstate, exportstate, 'after AtmRun', idumpcnt, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call AtmFieldDump(importstate, exportstate, 'after AtmRun', trim(export_timestr), rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif call ESMF_LogWrite("User routine ModelAdvance Atm finished", ESMF_LOGMSG_INFO) @@ -554,35 +442,20 @@ subroutine SetClock(model, rc) ! query the Component for its clock call ESMF_GridCompGet(model, clock=clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeIntervalSet(timestep, s_r8=dt_atmos, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockSet(clock, timestep=timestep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! initialize internal clock ! here: parent Clock and stability timeStep determine actual model timeStep call ESMF_TimeIntervalSet(stabilityTimeStep, s_r8=dt_atmos, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetClock(model, clock, stabilityTimeStep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine SetClock @@ -610,128 +483,41 @@ subroutine SetRunClock(model, rc) call NUOPC_ModelGet(model, & modelClock=modelClock, & driverClock=driverClock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! set the modelClock to have the current start time as the driverClock call ESMF_ClockGet(driverClock, currTime=currTime, timeStep=timeStep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeIntervalSet(timestep, s_r8=dt_atmos, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockSet(modelClock, currTime=currTime, timeStep=timestep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockPrint(modelClock, options="currTime", & preString="entering SetRunClock DATM with modelClock current: ", & unit=msgString) - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO) call ESMF_ClockPrint(driverClock, options="currTime", & preString="entering SetRunClock DATM with driverClock current: ", & unit=msgString) - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO) call ESMF_ClockPrint(modelClock, options="stopTime", & preString="entering SetRunClock DATM with modelClock stop: ", & unit=msgString) - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO) call ESMF_ClockPrint(driverClock, options="stopTime", & preString="entering SetRunClock DATM with driverClock stop: ", & unit=msgString) - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO) ! check and set the component clock against the driver clock call NUOPC_CompCheckSetClock(model, driverClock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite("User routine SetRunClock Atm finished", ESMF_LOGMSG_INFO) end subroutine SetRunClock - !----------------------------------------------------------------------------- - - subroutine CheckImport(model, rc) - - type(ESMF_GridComp) :: model - integer, intent(out) :: rc - - ! This is the routine that enforces the complex time dependence on the - ! import fields. - ! - ! local variables - type(ESMF_Clock) :: clock - type(ESMF_State) :: importState, exportState - type(ESMF_Time) :: currtime, starttime, stoptime - logical :: neededCurrent - logical :: atStopTime - - integer :: ii,nfields - character(len=ESMF_MAXSTR) :: msgString - - rc = ESMF_SUCCESS - - call ESMF_LogWrite("User routine CheckImport Atm started", ESMF_LOGMSG_INFO) - - call NUOPC_ModelGet(model, & - modelClock=clock, & - importState=importState, & - exportState=exportState, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! get the current time and stop time out of the clock - call ESMF_ClockGet(clock, & - currTime=currtime, & - startTime=starttime, & - stopTime=stoptime,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_ClockPrint(clock, options="currTime", & - preString="CheckImport with CLOCK current: ", & - unit=msgString) - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - call ESMF_ClockPrint(clock, options="startTime", & - preString="CheckImport with CLOCK start: ", & - unit=msgString) - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - call ESMF_ClockPrint(clock, options="stopTime", & - preString="CheckImport with CLOCK stop: ", & - unit=msgString) - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - - call ESMF_StateGet(importState, itemCount=nfields,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out -#ifdef coupled - !ensure fields from ATM are at stopTime - nfields = size(AtmFieldsToImport) - do ii=1,nfields - atStopTime = NUOPC_IsAtTime(importState, stopTime, & - fieldName=AtmFieldsToImport(ii)%field_name, rc=rc) - enddo -#endif - call ESMF_LogWrite("User routine CheckImport Atm finished", ESMF_LOGMSG_INFO) - - end subroutine CheckImport end module DAtm