diff --git a/atmos_model.F90 b/atmos_model.F90 index d0743af89..26868bedb 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -114,6 +114,7 @@ module atmos_model_mod public atmos_model_restart public get_atmos_model_ungridded_dim public addLsmask2grid +public setup_exportdata !----------------------------------------------------------------------- ! @@ -266,17 +267,8 @@ subroutine update_atmos_radiation_physics (Atmos) !--- if coupled, assign coupled fields - if( GFS_control%cplflx .or. GFS_control%cplwav ) then - -! if (mpp_pe() == mpp_root_pe() .and. debug) then -! print *,'in atmos_model,nblks=',Atm_block%nblks -! print *,'in atmos_model,GFS_data size=',size(GFS_data) -! print *,'in atmos_model,tsfc(1)=',GFS_data(1)%sfcprop%tsfc(1) -! print *,'in atmos_model, tsfc size=',size(GFS_data(1)%sfcprop%tsfc) -! endif - + if (.not. GFS_control%cplchm) then call assign_importdata(rc) - endif ! Calculate total non-physics tendencies by substracting old GFS Stateout @@ -546,7 +538,7 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) #endif call GFS_initialize (GFS_control, GFS_data%Statein, GFS_data%Stateout, GFS_data%Sfcprop, & - GFS_data%Coupling, GFS_data%Grid, GFS_data%Tbd, GFS_data%Cldprop, GFS_data%Radtend, & + GFS_data%Coupling, GFS_data%Grid, GFS_data%Tbd, GFS_data%Cldprop, GFS_data%Radtend, & GFS_data%Intdiag, GFS_interstitial, commglobal, mpp_npes(), Init_parm) !--- populate/associate the Diag container elements @@ -668,12 +660,6 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) !--- get bottom layer data from dynamical core for coupling call atmosphere_get_bottom_layer (Atm_block, DYCORE_Data) - !if in coupled mode, set up coupled fields - if (GFS_control%cplflx .or. GFS_control%cplwav) then - if (mpp_pe() == mpp_root_pe()) print *,'COUPLING: CCPP layer' - call setup_exportdata(ierr) - endif - ! Set flag for first time step of time integration GFS_control%first_time_step = .true. @@ -840,8 +826,8 @@ subroutine update_atmos_model_state (Atmos) call atmosphere_get_bottom_layer (Atm_block, DYCORE_Data) !if in coupled mode, set up coupled fields - if (GFS_control%cplflx .or. GFS_control%cplwav) then - call setup_exportdata(rc) + if (.not. GFS_control%cplchm) then + call setup_exportdata() endif end subroutine update_atmos_model_state @@ -1516,19 +1502,21 @@ end subroutine dealloc_atmos_data_type subroutine assign_importdata(rc) - use module_cplfields, only: importFields, nImportFields, QueryFieldList, & - ImportFieldsList, importFieldsValid + use module_cplfields, only: importFields, nImportFields, queryImportFields, & + importFieldsValid use ESMF ! implicit none integer, intent(out) :: rc !--- local variables - integer :: n, j, i, ix, nb, isc, iec, jsc, jec, dimCount, findex + integer :: n, j, i, k, ix, nb, isc, iec, jsc, jec, nk, dimCount, findex + integer :: sphum, liq_wat, ice_wat, o3mr character(len=128) :: impfield_name, fldname type(ESMF_TypeKind_Flag) :: datatype real(kind=ESMF_KIND_R4), dimension(:,:), pointer :: datar42d real(kind=ESMF_KIND_R8), dimension(:,:), pointer :: datar82d + real(kind=ESMF_KIND_R8), dimension(:,:,:), pointer:: datar83d real(kind=GFS_kind_phys), dimension(:,:), pointer :: datar8 real(kind=GFS_kind_phys) :: tem, ofrac logical found, isFieldCreated, lcpl_fice @@ -1536,12 +1524,14 @@ subroutine assign_importdata(rc) ! !------------------------------------------------------------------------------ ! -! set up local dimension rc = -999 + +! set up local dimension isc = GFS_control%isc iec = GFS_control%isc+GFS_control%nx-1 jsc = GFS_control%jsc jec = GFS_control%jsc+GFS_control%ny-1 + nk = Atm_block%npz lcpl_fice = .false. allocate(datar8(isc:iec,jsc:jec)) @@ -1555,7 +1545,6 @@ subroutine assign_importdata(rc) found = .false. - isFieldCreated = ESMF_FieldIsCreated(importFields(n), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -1579,14 +1568,22 @@ subroutine assign_importdata(rc) ! call ESMF_FieldGet(importFields(n),farrayPtr=datar42d,localDE=0, rc=rc) ! datar8 = datar42d endif + + else if( dimCount == 3) then + if ( datatype == ESMF_TYPEKIND_R8) then + call ESMF_FieldGet(importFields(n),farrayPtr=datar83d,localDE=0, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + found = .true. + endif endif ! - if (found .and. datar8(isc,jsc) > -99998.0) then + if (found) then + if (datar8(isc,jsc) > -99998.0) then ! ! get sea land mask: in order to update the coupling fields over the ocean/ice ! fldname = 'land_mask' ! if (trim(impfield_name) == trim(fldname)) then -! findex = QueryFieldList(ImportFieldsList,fldname) +! findex = queryImportFields(fldname) ! if (importFieldsValid(findex)) then !!$omp parallel do default(shared) private(i,j,nb,ix) ! do j=jsc,jec @@ -1605,7 +1602,7 @@ subroutine assign_importdata(rc) !---------------------------- fldname = 'wave_z0_roughness_length' if (trim(impfield_name) == trim(fldname)) then - findex = QueryFieldList(ImportFieldsList,fldname) + findex = queryImportFields(fldname) if (importFieldsValid(findex) .and. GFS_control%cplwav2atm) then !$omp parallel do default(shared) private(i,j,nb,ix,tem) do j=jsc,jec @@ -1630,7 +1627,7 @@ subroutine assign_importdata(rc) !-------------------------------- fldname = 'sea_ice_surface_temperature' if (trim(impfield_name) == trim(fldname)) then - findex = QueryFieldList(ImportFieldsList,fldname) + findex = queryImportFields(fldname) if (importFieldsValid(findex)) then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec @@ -1650,7 +1647,7 @@ subroutine assign_importdata(rc) !-------------------------------------------------------------------------- fldname = 'sea_surface_temperature' if (trim(impfield_name) == trim(fldname)) then - findex = QueryFieldList(ImportFieldsList,fldname) + findex = queryImportFields(fldname) if (importFieldsValid(findex)) then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec @@ -1671,7 +1668,7 @@ subroutine assign_importdata(rc) !----------------------------------------------------------------------- fldname = 'ice_fraction' if (trim(impfield_name) == trim(fldname)) then - findex = QueryFieldList(ImportFieldsList,fldname) + findex = queryImportFields(fldname) if (importFieldsValid(findex)) then lcpl_fice = .true. !$omp parallel do default(shared) private(i,j,nb,ix,ofrac) @@ -1707,7 +1704,7 @@ subroutine assign_importdata(rc) !---------------------------------------------- fldname = 'mean_up_lw_flx_ice' if (trim(impfield_name) == trim(fldname)) then - findex = QueryFieldList(ImportFieldsList,fldname) + findex = queryImportFields(fldname) if (importFieldsValid(findex)) then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec @@ -1734,7 +1731,7 @@ subroutine assign_importdata(rc) !------------------------------------------------ fldname = 'mean_laten_heat_flx_atm_into_ice' if (trim(impfield_name) == trim(fldname)) then - findex = QueryFieldList(ImportFieldsList,fldname) + findex = queryImportFields(fldname) if (importFieldsValid(findex)) then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec @@ -1754,7 +1751,7 @@ subroutine assign_importdata(rc) !-------------------------------------------------- fldname = 'mean_sensi_heat_flx_atm_into_ice' if (trim(impfield_name) == trim(fldname)) then - findex = QueryFieldList(ImportFieldsList,fldname) + findex = queryImportFields(fldname) if (importFieldsValid(findex)) then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec @@ -1774,7 +1771,7 @@ subroutine assign_importdata(rc) !------------------------------------------------------------ fldname = 'stress_on_air_ice_zonal' if (trim(impfield_name) == trim(fldname)) then - findex = QueryFieldList(ImportFieldsList,fldname) + findex = queryImportFields(fldname) if (importFieldsValid(findex)) then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec @@ -1794,7 +1791,7 @@ subroutine assign_importdata(rc) !----------------------------------------------------------------- fldname = 'stress_on_air_ice_merid' if (trim(impfield_name) == trim(fldname)) then - findex = QueryFieldList(ImportFieldsList,fldname) + findex = queryImportFields(fldname) if (importFieldsValid(findex)) then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec @@ -1814,7 +1811,7 @@ subroutine assign_importdata(rc) !---------------------------------------------- fldname = 'mean_ice_volume' if (trim(impfield_name) == trim(fldname)) then - findex = QueryFieldList(ImportFieldsList,fldname) + findex = queryImportFields(fldname) if (importFieldsValid(findex)) then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec @@ -1835,7 +1832,7 @@ subroutine assign_importdata(rc) !------------------------------------------- fldname = 'mean_snow_volume' if (trim(impfield_name) == trim(fldname)) then - findex = QueryFieldList(ImportFieldsList,fldname) + findex = queryImportFields(fldname) if (importFieldsValid(findex)) then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec @@ -1852,6 +1849,385 @@ subroutine assign_importdata(rc) endif endif ! if (datar8(isc,jsc) > -99999.0) then + + ! For JEDI + + sphum = get_tracer_index(MODEL_ATMOS, 'sphum') + liq_wat = get_tracer_index(MODEL_ATMOS, 'liq_wat') + ice_wat = get_tracer_index(MODEL_ATMOS, 'ice_wat') + o3mr = get_tracer_index(MODEL_ATMOS, 'o3mr') + + fldname = 'u' + if (trim(impfield_name) == trim(fldname)) then + findex = queryImportFields(fldname) + if (importFieldsValid(findex)) then +!$omp parallel do default(shared) private(i,j,k) + do k=1,nk + do j=jsc,jec + do i=isc,iec + Atm(mygrid)%u(i,j,k) = datar83d(i-isc+1,j-jsc+1,k) + enddo + enddo + enddo + endif + endif + + fldname = 'v' + if (trim(impfield_name) == trim(fldname)) then + findex = queryImportFields(fldname) + if (importFieldsValid(findex)) then +!$omp parallel do default(shared) private(i,j,k) + do k=1,nk + do j=jsc,jec + do i=isc,iec + Atm(mygrid)%v(i,j,k) = datar83d(i-isc+1,j-jsc+1,k) + enddo + enddo + enddo + endif + endif + + fldname = 'ua' + if (trim(impfield_name) == trim(fldname)) then + findex = queryImportFields(fldname) + if (importFieldsValid(findex)) then +!$omp parallel do default(shared) private(i,j,k) + do k=1,nk + do j=jsc,jec + do i=isc,iec + Atm(mygrid)%ua(i,j,k) = datar83d(i-isc+1,j-jsc+1,k) + enddo + enddo + enddo + endif + endif + + fldname = 'va' + if (trim(impfield_name) == trim(fldname)) then + findex = queryImportFields(fldname) + if (importFieldsValid(findex)) then +!$omp parallel do default(shared) private(i,j,k) + do k=1,nk + do j=jsc,jec + do i=isc,iec + Atm(mygrid)%va(i,j,k) = datar83d(i-isc+1,j-jsc+1,k) + enddo + enddo + enddo + endif + endif + + fldname = 't' + if (trim(impfield_name) == trim(fldname)) then + findex = queryImportFields(fldname) + if (importFieldsValid(findex)) then +!$omp parallel do default(shared) private(i,j,k) + do k=1,nk + do j=jsc,jec + do i=isc,iec + Atm(mygrid)%pt(i,j,k) = datar83d(i-isc+1,j-jsc+1,k) + enddo + enddo + enddo + endif + endif + + fldname = 'delp' + if (trim(impfield_name) == trim(fldname)) then + findex = queryImportFields(fldname) + if (importFieldsValid(findex)) then +!$omp parallel do default(shared) private(i,j,k) + do k=1,nk + do j=jsc,jec + do i=isc,iec + Atm(mygrid)%delp(i,j,k) = datar83d(i-isc+1,j-jsc+1,k) + enddo + enddo + enddo + endif + endif + + fldname = 'sphum' + if (trim(impfield_name) == trim(fldname) .and. sphum > 0) then + findex = queryImportFields(fldname) + if (importFieldsValid(findex)) then +!$omp parallel do default(shared) private(i,j,k) + do k=1,nk + do j=jsc,jec + do i=isc,iec + Atm(mygrid)%q(i,j,k,sphum) = datar83d(i-isc+1,j-jsc+1,k) + enddo + enddo + enddo + endif + endif + + fldname = 'ice_wat' + if (trim(impfield_name) == trim(fldname) .and. ice_wat > 0) then + findex = queryImportFields(fldname) + if (importFieldsValid(findex)) then +!$omp parallel do default(shared) private(i,j,k) + do k=1,nk + do j=jsc,jec + do i=isc,iec + Atm(mygrid)%q(i,j,k,ice_wat) = datar83d(i-isc+1,j-jsc+1,k) + enddo + enddo + enddo + endif + endif + + fldname = 'liq_wat' + if (trim(impfield_name) == trim(fldname) .and. liq_wat > 0) then + findex = queryImportFields(fldname) + if (importFieldsValid(findex)) then +!$omp parallel do default(shared) private(i,j,k) + do k=1,nk + do j=jsc,jec + do i=isc,iec + Atm(mygrid)%q(i,j,k,sphum) = datar83d(i-isc+1,j-jsc+1,k) + enddo + enddo + enddo + endif + endif + + fldname = 'o3mr' + if (trim(impfield_name) == trim(fldname) .and. o3mr > 0) then + findex = queryImportFields(fldname) + if (importFieldsValid(findex)) then +!$omp parallel do default(shared) private(i,j,k) + do k=1,nk + do j=jsc,jec + do i=isc,iec + Atm(mygrid)%q(i,j,k,o3mr) = datar83d(i-isc+1,j-jsc+1,k) + enddo + enddo + enddo + endif + endif + + fldname = 'phis' + if (trim(impfield_name) == trim(fldname)) then + findex = queryImportFields(fldname) + if (importFieldsValid(findex)) then +!$omp parallel do default(shared) private(i,j) + do j=jsc,jec + do i=isc,iec + Atm(mygrid)%phis(i,j) = datar82d(i-isc+1,j-jsc+1) + enddo + enddo + endif + endif + + fldname = 'u_srf' + if (trim(impfield_name) == trim(fldname)) then + findex = queryImportFields(fldname) + if (importFieldsValid(findex)) then +!$omp parallel do default(shared) private(i,j) + do j=jsc,jec + do i=isc,iec + Atm(mygrid)%u_srf(i,j) = datar82d(i-isc+1,j-jsc+1) + enddo + enddo + endif + endif + + fldname = 'v_srf' + if (trim(impfield_name) == trim(fldname)) then + findex = queryImportFields(fldname) + if (importFieldsValid(findex)) then +!$omp parallel do default(shared) private(i,j) + do j=jsc,jec + do i=isc,iec + Atm(mygrid)%v_srf(i,j) = datar82d(i-isc+1,j-jsc+1) + enddo + enddo + endif + endif + + ! physics + fldname = 'slmsk' + if (trim(impfield_name) == trim(fldname)) then + findex = queryImportFields(fldname) + if (importFieldsValid(findex)) then +!$omp parallel do default(shared) private(i,j,nb,ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + GFS_data(nb)%Sfcprop%slmsk(ix) = datar82d(i-isc+1,j-jsc+1) + enddo + enddo + endif + endif + + fldname = 'weasd' + if (trim(impfield_name) == trim(fldname)) then + findex = queryImportFields(fldname) + if (importFieldsValid(findex)) then +!$omp parallel do default(shared) private(i,j,nb,ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + GFS_data(nb)%Sfcprop%weasd(ix) = datar82d(i-isc+1,j-jsc+1) + enddo + enddo + endif + endif + + fldname = 'tsea' + if (trim(impfield_name) == trim(fldname)) then + findex = queryImportFields(fldname) + if (importFieldsValid(findex)) then +!$omp parallel do default(shared) private(i,j,nb,ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + GFS_data(nb)%Sfcprop%tsfco(ix) = datar82d(i-isc+1,j-jsc+1) + enddo + enddo + endif + endif + + fldname = 'vtype' + if (trim(impfield_name) == trim(fldname)) then + findex = queryImportFields(fldname) + if (importFieldsValid(findex)) then +!$omp parallel do default(shared) private(i,j,nb,ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + GFS_data(nb)%Sfcprop%vtype(ix) = datar82d(i-isc+1,j-jsc+1) + enddo + enddo + endif + endif + + fldname = 'stype' + if (trim(impfield_name) == trim(fldname)) then + findex = queryImportFields(fldname) + if (importFieldsValid(findex)) then +!$omp parallel do default(shared) private(i,j,nb,ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + GFS_data(nb)%Sfcprop%stype(ix) = datar82d(i-isc+1,j-jsc+1) + enddo + enddo + endif + endif + + fldname = 'vfrac' + if (trim(impfield_name) == trim(fldname)) then + findex = queryImportFields(fldname) + if (importFieldsValid(findex)) then +!$omp parallel do default(shared) private(i,j,nb,ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + GFS_data(nb)%Sfcprop%vfrac(ix) = datar82d(i-isc+1,j-jsc+1) + enddo + enddo + endif + endif + + fldname = 'stc' + if (trim(impfield_name) == trim(fldname)) then + findex = queryImportFields(fldname) + if (importFieldsValid(findex)) then +!$omp parallel do default(shared) private(i,j,nb,ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + GFS_data(nb)%Sfcprop%stc(ix,:) = datar83d(i-isc+1,j-jsc+1,:) + enddo + enddo + endif + endif + + fldname = 'smc' + if (trim(impfield_name) == trim(fldname)) then + findex = queryImportFields(fldname) + if (importFieldsValid(findex)) then +!$omp parallel do default(shared) private(i,j,nb,ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + GFS_data(nb)%Sfcprop%smc(ix,:) = datar83d(i-isc+1,j-jsc+1,:) + enddo + enddo + endif + endif + + fldname = 'snwdph' + if (trim(impfield_name) == trim(fldname)) then + findex = queryImportFields(fldname) + if (importFieldsValid(findex)) then +!$omp parallel do default(shared) private(i,j,nb,ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + GFS_data(nb)%Sfcprop%snowd(ix) = datar82d(i-isc+1,j-jsc+1) + enddo + enddo + endif + endif + + fldname = 'f10m' + if (trim(impfield_name) == trim(fldname)) then + findex = queryImportFields(fldname) + if (importFieldsValid(findex)) then +!$omp parallel do default(shared) private(i,j,nb,ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + GFS_data(nb)%Sfcprop%f10m(ix) = datar82d(i-isc+1,j-jsc+1) + enddo + enddo + endif + endif + + fldname = 'zorl' + if (trim(impfield_name) == trim(fldname)) then + findex = queryImportFields(fldname) + if (importFieldsValid(findex)) then +!$omp parallel do default(shared) private(i,j,nb,ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + GFS_data(nb)%Sfcprop%zorl(ix) = datar82d(i-isc+1,j-jsc+1) + enddo + enddo + endif + endif + + fldname = 't2m' + if (trim(impfield_name) == trim(fldname)) then + findex = queryImportFields(fldname) + if (importFieldsValid(findex)) then +!$omp parallel do default(shared) private(i,j,nb,ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + GFS_data(nb)%Sfcprop%t2m(ix) = datar82d(i-isc+1,j-jsc+1) + enddo + enddo + endif + endif + + endif ! if (found) then endif ! if (isFieldCreated) then enddo ! @@ -1926,577 +2302,561 @@ subroutine assign_importdata(rc) end subroutine assign_importdata ! - subroutine setup_exportdata (rc) - - use module_cplfields, only: exportData, nExportFields, exportFieldsList, & - queryFieldList, fillExportFields - - implicit none + subroutine setup_exportdata() -!------------------------------------------------------------------------------ + use ESMF - !--- interface variables - integer, intent(out) :: rc + use module_cplfields, only: exportFields !--- local variables - integer :: j, i, ix, nb, isc, iec, jsc, jec, idx + integer :: j, i, k, ix, nb, nk, isc, iec, jsc, jec, idx + integer :: sphum, liq_wat, ice_wat, o3mr real(GFS_kind_phys) :: rtime, rtimek -! - if (mpp_pe() == mpp_root_pe()) print *,'enter setup_exportdata' - isc = GFS_control%isc - iec = GFS_control%isc+GFS_control%nx-1 - jsc = GFS_control%jsc - jec = GFS_control%jsc+GFS_control%ny-1 + integer :: localrc, rc + integer :: n,dimCount + logical :: isCreated + type(ESMF_TypeKind_Flag) :: datatype + character(len=ESMF_MAXSTR) :: fieldName + real(kind=ESMF_KIND_R4), dimension(:,:), pointer :: datar42d + real(kind=ESMF_KIND_R8), dimension(:,:), pointer :: datar82d + real(kind=ESMF_KIND_R8), dimension(:,:,:), pointer :: datar83d + + isc = Atm_block%isc + iec = Atm_block%iec + jsc = Atm_block%jsc + jec = Atm_block%jec + nk = Atm_block%npz rtime = one / GFS_control%dtp rtimek = GFS_control%rho_h2o * rtime -! print *,'in cplExp,dim=',isc,iec,jsc,jec,'nExportFields=',nExportFields -! print *,'in cplExp,GFS_data, size', size(GFS_data) -! print *,'in cplExp,u10micpl, size', size(GFS_data(1)%coupling%u10mi_cpl) - if(.not.allocated(exportData)) then - allocate(exportData(isc:iec,jsc:jec,nExportFields)) - endif + do n=1, size(exportFields) + + datar42d => null() + datar82d => null() + datar83d => null() + + isCreated = ESMF_FieldIsCreated(exportFields(n), rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return + if (.not. isCreated) cycle + + call ESMF_FieldGet(exportFields(n), name=fieldname, dimCount=dimCount, typekind=datatype, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return + if (datatype == ESMF_TYPEKIND_R8) then + if (dimCount == 2) then + call ESMF_FieldGet(exportFields(n),farrayPtr=datar82d,localDE=0, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return + else if (dimCount == 3) then + call ESMF_FieldGet(exportFields(n),farrayPtr=datar83d,localDE=0, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return + else + write(0,*)'not implemented dimCount ',dimCount, trim(fieldname) + call ESMF_Finalize(endflag=ESMF_END_ABORT) + endif + else if (datatype == ESMF_TYPEKIND_R4) then + if (dimCount == 2) then + call ESMF_FieldGet(exportFields(n),farrayPtr=datar42d,localDE=0, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return + else + write(0,*)'not implemented dimCount ',dimCount, trim(fieldname) + call ESMF_Finalize(endflag=ESMF_END_ABORT) + endif + else + write(0,*) 'not implemented datatype ',datatype, trim(fieldname) + call ESMF_Finalize(endflag=ESMF_END_ABORT) + endif + - ! set cpl fields to export Data - if (GFS_control%cplflx .or. GFS_control%cplwav) then ! Instantaneous u wind (m/s) 10 m above ground - idx = queryfieldlist(exportFieldsList,'inst_zonal_wind_height10m') - if (idx > 0 ) then - if (mpp_pe() == mpp_root_pe() .and. debug) print *,'cpl, in get u10mi_cpl' + if (trim(fieldname) == 'inst_zonal_wind_height10m') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%u10mi_cpl(ix) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%u10mi_cpl(ix) enddo enddo endif ! Instantaneous v wind (m/s) 10 m above ground - idx = queryfieldlist(exportFieldsList,'inst_merid_wind_height10m') - if (idx > 0 ) then - if (mpp_pe() == mpp_root_pe() .and. debug) print *,'cpl, in get v10mi_cpl' + if (trim(fieldname) == 'inst_merid_wind_height10m') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%v10mi_cpl(ix) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%v10mi_cpl(ix) enddo enddo - if (mpp_pe() == mpp_root_pe() .and. debug) print *,'cpl, get v10mi_cpl, exportData=',exportData(isc,jsc,idx),'idx=',idx endif - endif !if cplflx or cplwav - - if (GFS_control%cplflx) then ! MEAN Zonal compt of momentum flux (N/m**2) - idx = queryfieldlist(exportFieldsList,'mean_zonal_moment_flx_atm') - if (idx > 0 ) then + if (trim(fieldname) == 'mean_zonal_moment_flx_atm') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%dusfc_cpl(ix) * rtime + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dusfc_cpl(ix) * rtime enddo enddo endif ! MEAN Merid compt of momentum flux (N/m**2) - idx = queryfieldlist(exportFieldsList,'mean_merid_moment_flx_atm') - if (idx > 0 ) then + if (trim(fieldname) == 'mean_merid_moment_flx_atm') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%dvsfc_cpl(ix) * rtime + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dvsfc_cpl(ix) * rtime enddo enddo endif ! MEAN Sensible heat flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'mean_sensi_heat_flx') - if (idx > 0 ) then + if (trim(fieldname) == 'mean_sensi_heat_flx') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%dtsfc_cpl(ix) * rtime + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dtsfc_cpl(ix) * rtime enddo enddo endif ! MEAN Latent heat flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'mean_laten_heat_flx') - if (idx > 0 ) then + if (trim(fieldname) == 'mean_laten_heat_flx') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%dqsfc_cpl(ix) * rtime + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dqsfc_cpl(ix) * rtime enddo enddo endif ! MEAN Downward LW heat flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'mean_down_lw_flx') - if (idx > 0 ) then + if (trim(fieldname) == 'mean_down_lw_flx') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%dlwsfc_cpl(ix) * rtime + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dlwsfc_cpl(ix) * rtime enddo enddo endif ! MEAN Downward SW heat flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'mean_down_sw_flx') - if (idx > 0 ) then + if (trim(fieldname) == 'mean_down_sw_flx') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%dswsfc_cpl(ix) * rtime + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dswsfc_cpl(ix) * rtime enddo enddo endif ! MEAN precipitation rate (kg/m2/s) - idx = queryfieldlist(exportFieldsList,'mean_prec_rate') - if (idx > 0 ) then + if (trim(fieldname) == 'mean_prec_rate') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%rain_cpl(ix) * rtimek + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%rain_cpl(ix) * rtimek enddo enddo endif ! Instataneous Zonal compt of momentum flux (N/m**2) - idx = queryfieldlist(exportFieldsList,'inst_zonal_moment_flx') - if (idx > 0 ) then + if (trim(fieldname) == 'inst_zonal_moment_flx') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%dusfci_cpl(ix) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dusfci_cpl(ix) enddo enddo endif ! Instataneous Merid compt of momentum flux (N/m**2) - idx = queryfieldlist(exportFieldsList,'inst_merid_moment_flx') - if (idx > 0 ) then + if (trim(fieldname) == 'inst_merid_moment_flx') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%dvsfci_cpl(ix) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dvsfci_cpl(ix) enddo enddo endif ! Instataneous Sensible heat flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'inst_sensi_heat_flx') - if (idx > 0 ) then + if (trim(fieldname) == 'inst_sensi_heat_flx') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%dtsfci_cpl(ix) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dtsfci_cpl(ix) enddo enddo endif ! Instataneous Latent heat flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'inst_laten_heat_flx') - if (idx > 0 ) then + if (trim(fieldname) == 'inst_laten_heat_flx') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%dqsfci_cpl(ix) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dqsfci_cpl(ix) enddo enddo endif ! Instataneous Downward long wave radiation flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'inst_down_lw_flx') - if (idx > 0 ) then + if (trim(fieldname) == 'inst_down_lw_flx') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%dlwsfci_cpl(ix) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dlwsfci_cpl(ix) enddo enddo endif ! Instataneous Downward solar radiation flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'inst_down_sw_flx') - if (idx > 0 ) then + if (trim(fieldname) == 'inst_down_sw_flx') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%dswsfci_cpl(ix) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dswsfci_cpl(ix) enddo enddo endif ! Instataneous Temperature (K) 2 m above ground - idx = queryfieldlist(exportFieldsList,'inst_temp_height2m') - if (idx > 0 ) then + if (trim(fieldname) == 'inst_temp_height2m') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%t2mi_cpl(ix) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%t2mi_cpl(ix) enddo enddo endif ! Instataneous Specific humidity (kg/kg) 2 m above ground - idx = queryfieldlist(exportFieldsList,'inst_spec_humid_height2m') - if (idx > 0 ) then + if (trim(fieldname) == 'inst_spec_humid_height2m') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%q2mi_cpl(ix) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%q2mi_cpl(ix) enddo enddo endif ! Instataneous Temperature (K) at surface - idx = queryfieldlist(exportFieldsList,'inst_temp_height_surface') - if (idx > 0 ) then + if (trim(fieldname) == 'inst_temp_height_surface') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%tsfci_cpl(ix) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%tsfci_cpl(ix) enddo enddo endif ! Instataneous Pressure (Pa) land and sea surface - idx = queryfieldlist(exportFieldsList,'inst_pres_height_surface') - if (idx > 0 ) then + if (trim(fieldname) == 'inst_pres_height_surface') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%psurfi_cpl(ix) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%psurfi_cpl(ix) enddo enddo endif ! Instataneous Surface height (m) - idx = queryfieldlist(exportFieldsList,'inst_surface_height') - if (idx > 0 ) then + if (trim(fieldname) == 'inst_surface_height') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%oro_cpl(ix) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%oro_cpl(ix) enddo enddo endif ! MEAN NET long wave radiation flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'mean_net_lw_flx') - if (idx > 0 ) then + if (trim(fieldname) == 'mean_net_lw_flx') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%nlwsfc_cpl(ix) * rtime + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nlwsfc_cpl(ix) * rtime enddo enddo endif ! MEAN NET solar radiation flux over the ocean (W/m**2) - idx = queryfieldlist(exportFieldsList,'mean_net_sw_flx') - if (idx > 0 ) then + if (trim(fieldname) == 'mean_net_sw_flx') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%nswsfc_cpl(ix) * rtime + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nswsfc_cpl(ix) * rtime enddo enddo endif ! Instataneous NET long wave radiation flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'inst_net_lw_flx') - if (idx > 0 ) then + if (trim(fieldname) == 'inst_net_lw_flx') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%nlwsfci_cpl(ix) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nlwsfci_cpl(ix) enddo enddo endif ! Instataneous NET solar radiation flux over the ocean (W/m**2) - idx = queryfieldlist(exportFieldsList,'inst_net_sw_flx') - if (idx > 0 ) then + if (trim(fieldname) == 'inst_net_sw_flx') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%nswsfci_cpl(ix) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nswsfci_cpl(ix) enddo enddo endif ! MEAN sfc downward nir direct flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'mean_down_sw_ir_dir_flx') - if (idx > 0 ) then + if (trim(fieldname) == 'mean_down_sw_ir_dir_flx') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%dnirbm_cpl(ix) * rtime + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dnirbm_cpl(ix) * rtime enddo enddo endif ! MEAN sfc downward nir diffused flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'mean_down_sw_ir_dif_flx') - if (idx > 0 ) then + if (trim(fieldname) == 'mean_down_sw_ir_dif_flx') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%dnirdf_cpl(ix) * rtime + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dnirdf_cpl(ix) * rtime enddo enddo endif ! MEAN sfc downward uv+vis direct flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'mean_down_sw_vis_dir_flx') - if (idx > 0 ) then + if (trim(fieldname) == 'mean_down_sw_vis_dir_flx') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%dvisbm_cpl(ix) * rtime + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dvisbm_cpl(ix) * rtime enddo enddo endif ! MEAN sfc downward uv+vis diffused flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'mean_down_sw_vis_dif_flx') - if (idx > 0 ) then + if (trim(fieldname) == 'mean_down_sw_vis_dif_flx') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%dvisdf_cpl(ix) * rtime + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dvisdf_cpl(ix) * rtime enddo enddo endif ! Instataneous sfc downward nir direct flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'inst_down_sw_ir_dir_flx') - if (idx > 0 ) then + if (trim(fieldname) == 'inst_down_sw_ir_dir_flx') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%dnirbmi_cpl(ix) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dnirbmi_cpl(ix) enddo enddo endif ! Instataneous sfc downward nir diffused flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'inst_down_sw_ir_dif_flx') - if (idx > 0 ) then + if (trim(fieldname) == 'inst_down_sw_ir_dif_flx') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%dnirdfi_cpl(ix) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dnirdfi_cpl(ix) enddo enddo endif ! Instataneous sfc downward uv+vis direct flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'inst_down_sw_vis_dir_flx') - if (idx > 0 ) then + if (trim(fieldname) == 'inst_down_sw_vis_dir_flx') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%dvisbmi_cpl(ix) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dvisbmi_cpl(ix) enddo enddo endif ! Instataneous sfc downward uv+vis diffused flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'inst_down_sw_vis_dif_flx') - if (idx > 0 ) then + if (trim(fieldname) == 'inst_down_sw_vis_dif_flx') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%dvisdfi_cpl(ix) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%dvisdfi_cpl(ix) enddo enddo endif ! MEAN NET sfc nir direct flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'mean_net_sw_ir_dir_flx') - if (idx > 0 ) then + if (trim(fieldname) == 'mean_net_sw_ir_dir_flx') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%nnirbm_cpl(ix) * rtime + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nnirbm_cpl(ix) * rtime enddo enddo endif ! MEAN NET sfc nir diffused flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'mean_net_sw_ir_dif_flx') - if (idx > 0 ) then + if (trim(fieldname) == 'mean_net_sw_ir_dif_flx') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%nnirdf_cpl(ix) * rtime + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nnirdf_cpl(ix) * rtime enddo enddo endif ! MEAN NET sfc uv+vis direct flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'mean_net_sw_vis_dir_flx') - if (idx > 0 ) then + if (trim(fieldname) == 'mean_net_sw_vis_dir_flx') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%nvisbm_cpl(ix) * rtime + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nvisbm_cpl(ix) * rtime enddo enddo endif ! MEAN NET sfc uv+vis diffused flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'mean_net_sw_vis_dif_flx') - if (idx > 0 ) then + if (trim(fieldname) == 'mean_net_sw_vis_dif_flx') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%nvisdf_cpl(ix) * rtime + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nvisdf_cpl(ix) * rtime enddo enddo endif ! Instataneous net sfc nir direct flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'inst_net_sw_ir_dir_flx') - if (idx > 0 ) then + if (trim(fieldname) == 'inst_net_sw_ir_dir_flx') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%nnirbmi_cpl(ix) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nnirbmi_cpl(ix) enddo enddo endif ! Instataneous net sfc nir diffused flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'inst_net_sw_ir_dif_flx') - if (idx > 0 ) then + if (trim(fieldname) == 'inst_net_sw_ir_dif_flx') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%nnirdfi_cpl(ix) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nnirdfi_cpl(ix) enddo enddo endif ! Instataneous net sfc uv+vis direct flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'inst_net_sw_vis_dir_flx') - if (idx > 0 ) then + if (trim(fieldname) == 'inst_net_sw_vis_dir_flx') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%nvisbmi_cpl(ix) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nvisbmi_cpl(ix) enddo enddo endif ! Instataneous net sfc uv+vis diffused flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'inst_net_sw_vis_dif_flx') - if (idx > 0 ) then + if (trim(fieldname) == 'inst_net_sw_vis_dif_flx') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%nvisdfi_cpl(ix) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%nvisdfi_cpl(ix) enddo enddo endif ! Land/Sea mask (sea:0,land:1) - idx = queryfieldlist(exportFieldsList,'inst_land_sea_mask') - if (idx > 0 ) then + if (trim(fieldname) == 'inst_land_sea_mask') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%slmsk_cpl(ix) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%slmsk_cpl(ix) enddo enddo endif @@ -2504,105 +2864,97 @@ subroutine setup_exportdata (rc) ! Data from DYCORE: ! bottom layer temperature (t) - idx = queryfieldlist(exportFieldsList,'inst_temp_height_lowest') - if (mpp_pe() == mpp_root_pe()) print *,'cpl, in get inst_temp_height_lowest' - if (idx > 0 ) then + if (trim(fieldname) == 'inst_temp_height_lowest') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) if (associated(DYCORE_Data(nb)%coupling%t_bot)) then - exportData(i,j,idx) = DYCORE_Data(nb)%coupling%t_bot(ix) + datar82d(i-isc+1,j-jsc+1) = DYCORE_Data(nb)%coupling%t_bot(ix) else - exportData(i,j,idx) = zero + datar82d(i-isc+1,j-jsc+1) = zero endif enddo enddo - if (mpp_pe() == mpp_root_pe()) print *,'cpl, in get inst_temp_height_lowest=',exportData(isc,jsc,idx) endif ! bottom layer specific humidity (q) !!! CHECK if tracer 1 is for specific humidity !!! - idx = queryfieldlist(exportFieldsList,'inst_spec_humid_height_lowest') - if (idx > 0 ) then + if (trim(fieldname) == 'inst_spec_humid_height_lowest') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) if (associated(DYCORE_Data(nb)%coupling%tr_bot)) then - exportData(i,j,idx) = DYCORE_Data(nb)%coupling%tr_bot(ix,1) + datar82d(i-isc+1,j-jsc+1) = DYCORE_Data(nb)%coupling%tr_bot(ix,1) else - exportData(i,j,idx) = zero + datar82d(i-isc+1,j-jsc+1) = zero endif enddo enddo endif ! bottom layer zonal wind (u) - idx = queryfieldlist(exportFieldsList,'inst_zonal_wind_height_lowest') - if (idx > 0 ) then + if (trim(fieldname) == 'inst_zonal_wind_height_lowest') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) if (associated(DYCORE_Data(nb)%coupling%u_bot)) then - exportData(i,j,idx) = DYCORE_Data(nb)%coupling%u_bot(ix) + datar82d(i-isc+1,j-jsc+1) = DYCORE_Data(nb)%coupling%u_bot(ix) else - exportData(i,j,idx) = zero + datar82d(i-isc+1,j-jsc+1) = zero endif enddo enddo endif ! bottom layer meridionalw wind (v) - idx = queryfieldlist(exportFieldsList,'inst_merid_wind_height_lowest') - if (idx > 0 ) then + if (trim(fieldname) == 'inst_merid_wind_height_lowest') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) if (associated(DYCORE_Data(nb)%coupling%v_bot)) then - exportData(i,j,idx) = DYCORE_Data(nb)%coupling%v_bot(ix) + datar82d(i-isc+1,j-jsc+1) = DYCORE_Data(nb)%coupling%v_bot(ix) else - exportData(i,j,idx) = zero + datar82d(i-isc+1,j-jsc+1) = zero endif enddo enddo endif ! bottom layer pressure (p) - idx = queryfieldlist(exportFieldsList,'inst_pres_height_lowest') - if (idx > 0 ) then + if (trim(fieldname) == 'inst_pres_height_lowest') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) if (associated(DYCORE_Data(nb)%coupling%p_bot)) then - exportData(i,j,idx) = DYCORE_Data(nb)%coupling%p_bot(ix) + datar82d(i-isc+1,j-jsc+1) = DYCORE_Data(nb)%coupling%p_bot(ix) else - exportData(i,j,idx) = zero + datar82d(i-isc+1,j-jsc+1) = zero endif enddo enddo endif ! bottom layer height (z) - idx = queryfieldlist(exportFieldsList,'inst_height_lowest') - if (idx > 0 ) then + if (trim(fieldname) == 'inst_height_lowest') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) if (associated(DYCORE_Data(nb)%coupling%z_bot)) then - exportData(i,j,idx) = DYCORE_Data(nb)%coupling%z_bot(ix) + datar82d(i-isc+1,j-jsc+1) = DYCORE_Data(nb)%coupling%z_bot(ix) else - exportData(i,j,idx) = zero + datar82d(i-isc+1,j-jsc+1) = zero endif enddo enddo @@ -2611,36 +2963,307 @@ subroutine setup_exportdata (rc) ! END Data from DYCORE. ! MEAN snow precipitation rate (kg/m2/s) - idx = queryfieldlist(exportFieldsList,'mean_fprec_rate') - if (idx > 0 ) then + if (trim(fieldname) == 'mean_fprec_rate') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = GFS_data(nb)%coupling%snow_cpl(ix) * rtimek + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%coupling%snow_cpl(ix) * rtimek enddo enddo endif ! oceanfrac used by atm to calculate fluxes - idx = queryfieldlist(exportFieldsList,'openwater_frac_in_atm') - if (idx > 0 ) then + if (trim(fieldname) == 'openwater_frac_in_atm') then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = (one - GFS_Data(nb)%Sfcprop%fice(ix))*GFS_Data(nb)%Sfcprop%oceanfrac(ix) + datar82d(i-isc+1,j-jsc+1) = (one - GFS_Data(nb)%Sfcprop%fice(ix))*GFS_Data(nb)%Sfcprop%oceanfrac(ix) enddo enddo endif - endif !cplflx + ! For JEDI -!--- -! Fill the export Fields for ESMF/NUOPC style coupling - call fillExportFields(exportData) + sphum = get_tracer_index(MODEL_ATMOS, 'sphum') + liq_wat = get_tracer_index(MODEL_ATMOS, 'liq_wat') + ice_wat = get_tracer_index(MODEL_ATMOS, 'ice_wat') + o3mr = get_tracer_index(MODEL_ATMOS, 'o3mr') + + if (trim(fieldname) == 'u') then +!$omp parallel do default(shared) private(i,j,k) + do k = 1, nk + do j=jsc,jec + do i=isc,iec + datar83d(i-isc+1,j-jsc+1,k) = Atm(mygrid)%u(i,j,k) + enddo + enddo + enddo + endif + + if (trim(fieldname) == 'v') then +!$omp parallel do default(shared) private(i,j,k) + do k = 1, nk + do j=jsc,jec + do i=isc,iec + datar83d(i-isc+1,j-jsc+1,k) = Atm(mygrid)%v(i,j,k) + enddo + enddo + enddo + endif + + if (trim(fieldname) == 'ua') then +!$omp parallel do default(shared) private(i,j,k,nb,ix) + do k = 1, nk + do j=jsc,jec + do i=isc,iec + datar83d(i-isc+1,j-jsc+1,k) = Atm(mygrid)%ua(i,j,k) + enddo + enddo + enddo + endif + + if (trim(fieldname) == 'va') then +!$omp parallel do default(shared) private(i,j,k) + do k = 1, nk + do j=jsc,jec + do i=isc,iec + datar83d(i-isc+1,j-jsc+1,k) = Atm(mygrid)%va(i,j,k) + enddo + enddo + enddo + endif + + if (trim(fieldname) == 't') then +!$omp parallel do default(shared) private(i,j,k) + do k = 1, nk + do j=jsc,jec + do i=isc,iec + datar83d(i-isc+1,j-jsc+1,k) = Atm(mygrid)%pt(i,j,k) + enddo + enddo + enddo + endif + + if (trim(fieldname) == 'delp') then +!$omp parallel do default(shared) private(i,j,k) + do k = 1, nk + do j=jsc,jec + do i=isc,iec + datar83d(i-isc+1,j-jsc+1,k) = Atm(mygrid)%delp(i,j,k) + enddo + enddo + enddo + endif + + if (trim(fieldname) == 'sphum' .and. sphum > 0) then +!$omp parallel do default(shared) private(i,j,k) + do k = 1, nk + do j=jsc,jec + do i=isc,iec + datar83d(i-isc+1,j-jsc+1,k) = Atm(mygrid)%q(i,j,k,sphum) + enddo + enddo + enddo + endif + + if (trim(fieldname) == 'ice_wat' .and. ice_wat > 0) then +!$omp parallel do default(shared) private(i,j,k) + do k = 1, nk + do j=jsc,jec + do i=isc,iec + datar83d(i-isc+1,j-jsc+1,k) = Atm(mygrid)%q(i,j,k,ice_wat) + enddo + enddo + enddo + endif + + if (trim(fieldname) == 'liq_wat' .and. liq_wat > 0) then +!$omp parallel do default(shared) private(i,j,k) + do k = 1, nk + do j=jsc,jec + do i=isc,iec + datar83d(i-isc+1,j-jsc+1,k) = Atm(mygrid)%q(i,j,k,liq_wat) + enddo + enddo + enddo + endif + + if (trim(fieldname) == 'o3mr' .and. o3mr > 0) then +!$omp parallel do default(shared) private(i,j,k) + do k = 1, nk + do j=jsc,jec + do i=isc,iec + datar83d(i-isc+1,j-jsc+1,k) = Atm(mygrid)%q(i,j,k,o3mr) + enddo + enddo + enddo + endif + + if (trim(fieldname) == 'phis') then +!$omp parallel do default(shared) private(i,j) + do j=jsc,jec + do i=isc,iec + datar82d(i-isc+1,j-jsc+1) = Atm(mygrid)%phis(i,j) + enddo + enddo + endif + + if (trim(fieldname) == 'u_srf') then +!$omp parallel do default(shared) private(i,j) + do j=jsc,jec + do i=isc,iec + datar82d(i-isc+1,j-jsc+1) = Atm(mygrid)%u_srf(i,j) + enddo + enddo + endif + + if (trim(fieldname) == 'v_srf') then +!$omp parallel do default(shared) private(i,j) + do j=jsc,jec + do i=isc,iec + datar82d(i-isc+1,j-jsc+1) = Atm(mygrid)%v_srf(i,j) + enddo + enddo + endif + + ! physics + if (trim(fieldname) == 'slmsk') then +!$omp parallel do default(shared) private(i,j,nb,ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%Sfcprop%slmsk(ix) + enddo + enddo + endif + + if (trim(fieldname) == 'weasd') then +!$omp parallel do default(shared) private(i,j,nb,ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%Sfcprop%weasd(ix) + enddo + enddo + endif + + if (trim(fieldname) == 'tsea') then +!$omp parallel do default(shared) private(i,j,nb,ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%Sfcprop%tsfco(ix) + enddo + enddo + endif + + if (trim(fieldname) == 'vtype') then +!$omp parallel do default(shared) private(i,j,nb,ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%Sfcprop%vtype(ix) + enddo + enddo + endif + + if (trim(fieldname) == 'stype') then +!$omp parallel do default(shared) private(i,j,nb,ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%Sfcprop%stype(ix) + enddo + enddo + endif + + if (trim(fieldname) == 'vfrac') then +!$omp parallel do default(shared) private(i,j,nb,ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%Sfcprop%vfrac(ix) + enddo + enddo + endif + + if (trim(fieldname) == 'stc') then +!$omp parallel do default(shared) private(i,j,nb,ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + datar83d(i-isc+1,j-jsc+1,:) = GFS_data(nb)%Sfcprop%stc(ix,:) + enddo + enddo + endif + + if (trim(fieldname) == 'smc') then +!$omp parallel do default(shared) private(i,j,nb,ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + datar83d(i-isc+1,j-jsc+1,:) = GFS_data(nb)%Sfcprop%smc(ix,:) + enddo + enddo + endif + + if (trim(fieldname) == 'snwdph') then +!$omp parallel do default(shared) private(i,j,nb,ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%Sfcprop%snowd(ix) + enddo + enddo + endif + + if (trim(fieldname) == 'f10m') then +!$omp parallel do default(shared) private(i,j,nb,ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%Sfcprop%f10m(ix) + enddo + enddo + endif + + if (trim(fieldname) == 'zorl') then +!$omp parallel do default(shared) private(i,j,nb,ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%Sfcprop%zorl(ix) + enddo + enddo + endif + + if (trim(fieldname) == 't2m') then +!$omp parallel do default(shared) private(i,j,nb,ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + datar82d(i-isc+1,j-jsc+1) = GFS_data(nb)%Sfcprop%t2m(ix) + enddo + enddo + endif + + enddo ! exportFields !--- if (GFS_control%cplflx) then @@ -2672,7 +3295,6 @@ subroutine setup_exportdata (rc) enddo if (mpp_pe() == mpp_root_pe()) print *,'zeroing coupling accumulated fields at kdt= ',GFS_control%kdt endif !cplflx -! if (mpp_pe() == mpp_root_pe()) print *,'end of setup_exportdata' end subroutine setup_exportdata diff --git a/cpl/module_cap_cpl.F90 b/cpl/module_cap_cpl.F90 index 128e72716..3f7026ede 100644 --- a/cpl/module_cap_cpl.F90 +++ b/cpl/module_cap_cpl.F90 @@ -5,13 +5,15 @@ module module_cap_cpl ! revision history ! 12 Mar 2018: J. Wang Pull coupled subroutines from fv3_cap.F90 to this module ! - use esmf + use ESMF use NUOPC + + use module_cplfields, only : FieldInfo ! implicit none private public clock_cplIntval - public realizeConnectedInternCplField + ! public realizeConnectedInternCplField public realizeConnectedCplFields public diagnose_cplFields ! @@ -50,7 +52,7 @@ subroutine clock_cplIntval(gcomp, CF) end subroutine clock_cplIntval !----------------------------------------------------------------------------- - +#if 0 subroutine realizeConnectedInternCplField(state, field, standardName, grid, rc) type(ESMF_State) :: state @@ -95,14 +97,14 @@ subroutine realizeConnectedInternCplField(state, field, standardName, grid, rc) endif end subroutine realizeConnectedInternCplField - +#endif !----------------------------------------------------------------------------- subroutine realizeConnectedCplFields(state, grid, & numLevels, numSoilLayers, numTracers, & num_diag_sfc_emis_flux, num_diag_down_flux, & num_diag_type_down_flux, num_diag_burn_emis_flux, & - num_diag_cmass, fieldNames, fieldTypes, state_tag,& + num_diag_cmass, fields_info, state_tag, & fieldList, rc) type(ESMF_State), intent(inout) :: state @@ -115,8 +117,7 @@ subroutine realizeConnectedCplFields(state, grid, integer, intent(in) :: num_diag_type_down_flux integer, intent(in) :: num_diag_burn_emis_flux integer, intent(in) :: num_diag_cmass - character(len=*), dimension(:), intent(in) :: fieldNames - character(len=*), dimension(:), intent(in) :: fieldTypes + type(FieldInfo), dimension(:), intent(in) :: fields_info character(len=*), intent(in) :: state_tag !< Import or export. type(ESMF_Field), dimension(:), intent(out) :: fieldList integer, intent(out) :: rc @@ -129,21 +130,15 @@ subroutine realizeConnectedCplFields(state, grid, ! begin rc = ESMF_SUCCESS - if (size(fieldNames) /= size(fieldTypes)) then - call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, & - msg="fieldNames and fieldTypes must have same size.", line=__LINE__, file=__FILE__, rcToReturn=rc) - return - end if - - do item = 1, size(fieldNames) - isConnected = NUOPC_IsConnected(state, fieldName=trim(fieldNames(item)), rc=rc) + do item = 1, size(fields_info) + isConnected = NUOPC_IsConnected(state, fieldName=trim(fields_info(item)%name), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (isConnected) then - call ESMF_StateGet(state, field=field, itemName=trim(fieldNames(item)), rc=rc) + call ESMF_StateGet(state, field=field, itemName=trim(fields_info(item)%name), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_FieldEmptySet(field, grid=grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - select case (fieldTypes(item)) + select case (fields_info(item)%type) case ('l','layer') call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, & ungriddedLBound=(/1/), ungriddedUBound=(/numLevels/), rc=rc) @@ -182,7 +177,7 @@ subroutine realizeConnectedCplFields(state, grid, if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return case default call ESMF_LogSetError(ESMF_RC_NOT_VALID, & - msg="exportFieldType = '"//trim(fieldTypes(item))//"' not recognized", & + msg="exportFieldType = '"//trim(fields_info(item)%type)//"' not recognized", & line=__LINE__, file=__FILE__, rcToReturn=rc) return end select @@ -195,13 +190,13 @@ subroutine realizeConnectedCplFields(state, grid, ! -- save field fieldList(item) = field - call ESMF_LogWrite('realizeConnectedCplFields '//trim(state_tag)//' Field '//trim(fieldNames(item)) & + call ESMF_LogWrite('realizeConnectedCplFields '//trim(state_tag)//' Field '//trim(fields_info(item)%name) & // ' is connected ', ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__, rc=rc) else ! remove a not connected Field from State - call ESMF_StateRemove(state, (/trim(fieldNames(item))/), rc=rc) + call ESMF_StateRemove(state, (/trim(fields_info(item)%name)/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_LogWrite('realizeConnectedCplFields '//trim(state_tag)//' Field '//trim(fieldNames(item)) & + call ESMF_LogWrite('realizeConnectedCplFields '//trim(state_tag)//' Field '//trim(fields_info(item)%name) & // ' is not connected ', ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__, rc=rc) end if end do @@ -210,64 +205,61 @@ end subroutine realizeConnectedCplFields !----------------------------------------------------------------------------- - subroutine diagnose_cplFields(gcomp, importState, exportstate, clock_fv3, & - fcstpe, statewrite_flag, stdiagnose_flag, state_tag, timestr) + subroutine diagnose_cplFields(gcomp, clock_fv3, fcstpe, & + statewrite_flag, stdiagnose_flag, state_tag) type(ESMF_GridComp), intent(in) :: gcomp - type(ESMF_State) :: importState, exportstate type(ESMF_Clock),intent(in) :: clock_fv3 logical, intent(in) :: fcstpe logical, intent(in) :: statewrite_flag integer, intent(in) :: stdiagnose_flag character(len=*), intent(in) :: state_tag !< Import or export. - character(len=*), intent(in) :: timestr !< Import or export. - integer :: timeslice = 1 -! + + character(len=*),parameter :: subname='(module_cap_cpl:diagnose_cplFields)' + type(ESMF_Time) :: currTime + type(ESMF_State) :: state + character(len=240) :: timestr + integer :: timeslice = 1 character(len=160) :: nuopcMsg character(len=160) :: filename integer :: rc ! - call ESMF_ClockPrint(clock_fv3, options="currTime", & - preString="leaving FV3_ADVANCE with clock_fv3 current: ", & - unit=nuopcMsg) -! call ESMF_LogWrite(nuopcMsg, ESMF_LOGMSG_INFO) - call ESMF_ClockPrint(clock_fv3, options="startTime", & - preString="leaving FV3_ADVANCE with clock_fv3 start: ", & - unit=nuopcMsg) -! call ESMF_LogWrite(nuopcMsg, ESMF_LOGMSG_INFO) - call ESMF_ClockPrint(clock_fv3, options="stopTime", & - preString="leaving FV3_ADVANCE with clock_fv3 stop: ", & - unit=nuopcMsg) -! call ESMF_LogWrite(nuopcMsg, ESMF_LOGMSG_INFO) + call ESMF_ClockGet(clock_fv3, currTime=currTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_TimeGet(currTime, timestring=timestr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_ClockPrint(clock_fv3, options="currTime", preString="current time: ", unit=nuopcMsg) + call ESMF_LogWrite(trim(subname)//' '//trim(state_tag)//' '//trim(nuopcMsg), ESMF_LOGMSG_INFO) if(trim(state_tag) .eq. 'import')then - call ESMF_GridCompGet(gcomp, importState=importState, rc=rc) + call ESMF_GridCompGet(gcomp, importState=state, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if(stdiagnose_flag > 0 .and. fcstpe)then - call state_diagnose(importState, ':IS', rc=rc) + call state_diagnose(state, ':IS', rc=rc) end if ! Dump Fields out if (statewrite_flag) then write(filename,'(A)') 'fv3_cap_import_'//trim(timestr)//'_' - call State_RWFields_tiles(importState,trim(filename), timeslice, rc=rc) + call State_RWFields_tiles(state,trim(filename), timeslice, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return end if end if if(trim(state_tag) .eq. 'export')then - call ESMF_GridCompGet(gcomp, exportState=exportState, rc=rc) + call ESMF_GridCompGet(gcomp, exportState=state, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if(stdiagnose_flag > 0 .and. fcstpe)then - call state_diagnose(exportState, ':ES', rc=rc) + call state_diagnose(state, ':ES', rc=rc) end if ! Dump Fields out if (statewrite_flag) then write(filename,'(A)') 'fv3_cap_export_'//trim(timestr)//'_' - call State_RWFields_tiles(exportState,trim(filename), timeslice, rc=rc) + call State_RWFields_tiles(state,trim(filename), timeslice, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return end if end if @@ -398,8 +390,7 @@ subroutine State_RWFields_tiles(state,filename,timeslice,rc) ! local variables rc = ESMF_SUCCESS - !call ESMF_LogWrite(trim(subname)//trim(filename)//": called", - !ESMF_LOGMSG_INFO, rc=rc) + !call ESMF_LogWrite(trim(subname)//trim(filename)//": called", ESMF_LOGMSG_INFO, rc=rc) call ESMF_StateGet(state, itemCount=icount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -439,7 +430,6 @@ subroutine State_RWFields_tiles(state,filename,timeslice,rc) IOComp = ESMFIO_Create(gridFv3, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_LogWrite(trim(subname)//": write "//trim(filename), ESMF_LOGMSG_INFO, rc=rc) do ifld=1, fieldCount call ESMF_StateGet(state, itemName=fldNameList(ifld), field=flds(ifld), rc=rc) @@ -456,8 +446,7 @@ subroutine State_RWFields_tiles(state,filename,timeslice,rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) call ESMF_Finalize() - !call ESMF_LogWrite(trim(subname)//trim(filename)//": finished", - !ESMF_LOGMSG_INFO, rc=rc) + !call ESMF_LogWrite(trim(subname)//trim(filename)//": finished", ESMF_LOGMSG_INFO, rc=rc) end subroutine State_RWFields_tiles @@ -495,32 +484,32 @@ subroutine state_diagnose(State,string, rc) call ESMF_StateGet(State, itemCount=itemCount, rc=lrc) if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return allocate(itemNameList(itemCount)) - + call ESMF_StateGet(State, itemNameList=itemNameList, rc=lrc) if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + do n = 1, itemCount call ESMF_StateGet(State, itemName=trim(itemNameList(n)), itemType=itemType, rc=lrc) if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if(itemType == ESMF_STATEITEM_FIELD)then call ESMF_StateGet(State, itemName=trim(itemNameList(n)), field=lfield, rc=lrc) if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + call ESMF_FieldGet(lfield, dimCount=dimcount, rc=lrc) if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if(dimcount == 2)then call ESMF_FieldGet(lfield, farrayPtr=dataPtr2d, rc=lrc) if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + write(tmpstr,'(A,3g14.7)') trim(subname)//' '//trim(lstring)//':'//trim(itemNameList(n))//' ', & minval(dataPtr2d),maxval(dataPtr2d),sum(dataPtr2d) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=lrc) else call ESMF_FieldGet(lfield, farrayPtr=dataPtr3d, rc=lrc) if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + write(tmpstr,'(A,3g14.7)') trim(subname)//' '//trim(lstring)//':'//trim(itemNameList(n))//' ', & minval(dataPtr3d),maxval(dataPtr3d),sum(dataPtr3d) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=lrc) diff --git a/cpl/module_cplfields.F90 b/cpl/module_cplfields.F90 index cb941bf0b..de1946e79 100644 --- a/cpl/module_cplfields.F90 +++ b/cpl/module_cplfields.F90 @@ -6,249 +6,215 @@ module module_cplfields !----------------------------------------------------------------------------- use ESMF - use NUOPC implicit none private + type, public :: FieldInfo + character(len=41) :: name + character(len=1) :: type + end type + ! Export Fields ---------------------------------------- - integer, public, parameter :: NexportFields = 72 + integer, public, parameter :: NexportFields = 97 type(ESMF_Field), target, public :: exportFields(NexportFields) - character(len=*), public, parameter :: exportFieldsList(NexportFields) = (/ & - "inst_pres_interface ", & - "inst_pres_levels ", & - "inst_geop_interface ", & - "inst_geop_levels ", & - "inst_temp_levels ", & - "inst_zonal_wind_levels ", & - "inst_merid_wind_levels ", & - "inst_omega_levels ", & - "inst_tracer_mass_frac ", & - "soil_type ", & - "inst_pbl_height ", & - "surface_cell_area ", & - "inst_convective_rainfall_amount ", & - "inst_exchange_coefficient_heat_levels ", & - "inst_spec_humid_conv_tendency_levels ", & - "inst_friction_velocity ", & - "inst_rainfall_amount ", & - "inst_soil_moisture_content ", & - "inst_up_sensi_heat_flx ", & - "inst_lwe_snow_thickness ", & - "vegetation_type ", & - "inst_vegetation_area_frac ", & - "inst_surface_roughness ", & - "mean_zonal_moment_flx_atm ", & - "mean_merid_moment_flx_atm ", & - "mean_sensi_heat_flx ", & - "mean_laten_heat_flx ", & - "mean_down_lw_flx ", & - "mean_down_sw_flx ", & - "mean_prec_rate ", & - "inst_zonal_moment_flx ", & - "inst_merid_moment_flx ", & - "inst_sensi_heat_flx ", & - "inst_laten_heat_flx ", & - "inst_down_lw_flx ", & - "inst_down_sw_flx ", & - "inst_temp_height2m ", & - "inst_spec_humid_height2m ", & - "inst_zonal_wind_height10m ", & - "inst_merid_wind_height10m ", & - "inst_temp_height_surface ", & - "inst_pres_height_surface ", & - "inst_surface_height ", & - "mean_net_lw_flx ", & - "mean_net_sw_flx ", & - "inst_net_lw_flx ", & - "inst_net_sw_flx ", & - "mean_down_sw_ir_dir_flx ", & - "mean_down_sw_ir_dif_flx ", & - "mean_down_sw_vis_dir_flx ", & - "mean_down_sw_vis_dif_flx ", & - "inst_down_sw_ir_dir_flx ", & - "inst_down_sw_ir_dif_flx ", & - "inst_down_sw_vis_dir_flx ", & - "inst_down_sw_vis_dif_flx ", & - "mean_net_sw_ir_dir_flx ", & - "mean_net_sw_ir_dif_flx ", & - "mean_net_sw_vis_dir_flx ", & - "mean_net_sw_vis_dif_flx ", & - "inst_net_sw_ir_dir_flx ", & - "inst_net_sw_ir_dif_flx ", & - "inst_net_sw_vis_dir_flx ", & - "inst_net_sw_vis_dif_flx ", & - "inst_land_sea_mask ", & - "inst_temp_height_lowest ", & - "inst_spec_humid_height_lowest ", & - "inst_zonal_wind_height_lowest ", & - "inst_merid_wind_height_lowest ", & - "inst_pres_height_lowest ", & - "inst_height_lowest ", & - "mean_fprec_rate ", & - "openwater_frac_in_atm " & -! "northward_wind_neutral ", & -! "eastward_wind_neutral ", & -! "upward_wind_neutral ", & -! "temp_neutral ", & -! "O_Density ", & -! "O2_Density ", & -! "N2_Density ", & -! "height " & - /) - ! Field types should be provided for proper handling - ! according to the table below: - ! g : soil levels (3D) - ! i : interface (3D) - ! l : model levels (3D) - ! s : surface (2D) - ! t : tracers (4D) - character(len=*), public, parameter :: exportFieldTypes(NexportFields) = (/ & - "i","l","i","l","l","l","l","l","t", & - "s","s","s","s","l","l","s","s","g", & - "s","s","s","s","s","s","s","s", & - "s","s","s","s","s","s","s","s", & - "s","s","s","s","s","s","s","s", & - "s","s","s","s","s","s","s","s", & - "s","s","s","s","s","s","s","s", & - "s","s","s","s","s","s","s","s", & - "s","s","s","s","s","s" & -! "l","l","l","l","l","l","l","s", & - /) - ! Set exportFieldShare to .true. if field is provided as memory reference - ! to coupled components - logical, public, parameter :: exportFieldShare(NexportFields) = (/ & - .true. ,.true. ,.true. ,.true. ,.true. , & - .true. ,.true. ,.true. ,.true. ,.true. , & - .true. ,.true. ,.true. ,.true. ,.true. , & - .true. ,.true. ,.true. ,.true. ,.true. , & - .true. ,.true. ,.true. ,.false.,.false., & - .false.,.false.,.false.,.false.,.false., & - .false.,.false.,.false.,.false.,.false. , & - .true. ,.false.,.false.,.false.,.false. , & - .true. ,.false.,.false.,.false.,.false., & - .false.,.false.,.false.,.false.,.false., & - .false.,.false.,.false.,.false.,.false., & - .false.,.false.,.false.,.false.,.false., & - .false.,.false.,.false.,.true. ,.false., & - .false.,.false.,.false.,.false.,.false., & - .false.,.false. & -! .false.,.false.,.false.,.false.,.false., & -! .false.,.false.,.false. & - /) - real(kind=8), allocatable, public :: exportData(:,:,:) + + type(FieldInfo), dimension(NexportFields), public, parameter :: exportFieldsInfo = [ & + FieldInfo("inst_pres_interface ", "i"), & + FieldInfo("inst_pres_levels ", "l"), & + FieldInfo("inst_geop_interface ", "i"), & + FieldInfo("inst_geop_levels ", "l"), & + FieldInfo("inst_temp_levels ", "l"), & + FieldInfo("inst_zonal_wind_levels ", "l"), & + FieldInfo("inst_merid_wind_levels ", "l"), & + FieldInfo("inst_omega_levels ", "l"), & + FieldInfo("inst_tracer_mass_frac ", "t"), & + FieldInfo("soil_type ", "s"), & + FieldInfo("inst_pbl_height ", "s"), & + FieldInfo("surface_cell_area ", "s"), & + FieldInfo("inst_convective_rainfall_amount ", "s"), & + FieldInfo("inst_exchange_coefficient_heat_levels ", "l"), & + FieldInfo("inst_spec_humid_conv_tendency_levels ", "l"), & + FieldInfo("inst_friction_velocity ", "s"), & + FieldInfo("inst_rainfall_amount ", "s"), & + FieldInfo("inst_soil_moisture_content ", "g"), & + FieldInfo("inst_up_sensi_heat_flx ", "s"), & + FieldInfo("inst_lwe_snow_thickness ", "s"), & + FieldInfo("vegetation_type ", "s"), & + FieldInfo("inst_vegetation_area_frac ", "s"), & + FieldInfo("inst_surface_roughness ", "s"), & + FieldInfo("mean_zonal_moment_flx_atm ", "s"), & + FieldInfo("mean_merid_moment_flx_atm ", "s"), & + FieldInfo("mean_sensi_heat_flx ", "s"), & + FieldInfo("mean_laten_heat_flx ", "s"), & + FieldInfo("mean_down_lw_flx ", "s"), & + FieldInfo("mean_down_sw_flx ", "s"), & + FieldInfo("mean_prec_rate ", "s"), & + FieldInfo("inst_zonal_moment_flx ", "s"), & + FieldInfo("inst_merid_moment_flx ", "s"), & + FieldInfo("inst_sensi_heat_flx ", "s"), & + FieldInfo("inst_laten_heat_flx ", "s"), & + FieldInfo("inst_down_lw_flx ", "s"), & + FieldInfo("inst_down_sw_flx ", "s"), & + FieldInfo("inst_temp_height2m ", "s"), & + FieldInfo("inst_spec_humid_height2m ", "s"), & + FieldInfo("inst_zonal_wind_height10m ", "s"), & + FieldInfo("inst_merid_wind_height10m ", "s"), & + FieldInfo("inst_temp_height_surface ", "s"), & + FieldInfo("inst_pres_height_surface ", "s"), & + FieldInfo("inst_surface_height ", "s"), & + FieldInfo("mean_net_lw_flx ", "s"), & + FieldInfo("mean_net_sw_flx ", "s"), & + FieldInfo("inst_net_lw_flx ", "s"), & + FieldInfo("inst_net_sw_flx ", "s"), & + FieldInfo("mean_down_sw_ir_dir_flx ", "s"), & + FieldInfo("mean_down_sw_ir_dif_flx ", "s"), & + FieldInfo("mean_down_sw_vis_dir_flx ", "s"), & + FieldInfo("mean_down_sw_vis_dif_flx ", "s"), & + FieldInfo("inst_down_sw_ir_dir_flx ", "s"), & + FieldInfo("inst_down_sw_ir_dif_flx ", "s"), & + FieldInfo("inst_down_sw_vis_dir_flx ", "s"), & + FieldInfo("inst_down_sw_vis_dif_flx ", "s"), & + FieldInfo("mean_net_sw_ir_dir_flx ", "s"), & + FieldInfo("mean_net_sw_ir_dif_flx ", "s"), & + FieldInfo("mean_net_sw_vis_dir_flx ", "s"), & + FieldInfo("mean_net_sw_vis_dif_flx ", "s"), & + FieldInfo("inst_net_sw_ir_dir_flx ", "s"), & + FieldInfo("inst_net_sw_ir_dif_flx ", "s"), & + FieldInfo("inst_net_sw_vis_dir_flx ", "s"), & + FieldInfo("inst_net_sw_vis_dif_flx ", "s"), & + FieldInfo("inst_land_sea_mask ", "s"), & + FieldInfo("inst_temp_height_lowest ", "s"), & + FieldInfo("inst_spec_humid_height_lowest ", "s"), & + FieldInfo("inst_zonal_wind_height_lowest ", "s"), & + FieldInfo("inst_merid_wind_height_lowest ", "s"), & + FieldInfo("inst_pres_height_lowest ", "s"), & + FieldInfo("inst_height_lowest ", "s"), & + FieldInfo("mean_fprec_rate ", "s"), & + FieldInfo("openwater_frac_in_atm ", "s"), & + + ! For JEDI + ! dynamics + FieldInfo("u ", "l"), & + FieldInfo("v ", "l"), & + FieldInfo("ua ", "l"), & + FieldInfo("va ", "l"), & + FieldInfo("t ", "l"), & + FieldInfo("delp ", "l"), & + FieldInfo("sphum ", "l"), & + FieldInfo("ice_wat ", "l"), & + FieldInfo("liq_wat ", "l"), & + FieldInfo("o3mr ", "l"), & + FieldInfo("phis ", "s"), & + FieldInfo("u_srf ", "s"), & + FieldInfo("v_srf ", "s"), & + ! physics + FieldInfo("slmsk ", "s"), & + FieldInfo("weasd ", "s"), & + FieldInfo("tsea ", "s"), & + FieldInfo("vtype ", "s"), & + FieldInfo("stype ", "s"), & + FieldInfo("vfrac ", "s"), & + FieldInfo("stc ", "g"), & + FieldInfo("smc ", "g"), & + FieldInfo("snwdph ", "s"), & + FieldInfo("f10m ", "s"), & + FieldInfo("zorl ", "s"), & + FieldInfo("t2m ", "s") ] ! Import Fields ---------------------------------------- - integer, public, parameter :: NimportFields = 17 + integer, public, parameter :: NimportFields = 42 logical, public :: importFieldsValid(NimportFields) type(ESMF_Field), target, public :: importFields(NimportFields) - character(len=*), public, parameter :: importFieldsList(NimportFields) = (/ & - "inst_tracer_mass_frac ", & - "land_mask ", & - "sea_ice_surface_temperature ", & - "sea_surface_temperature ", & - "ice_fraction ", & -! "inst_ice_ir_dif_albedo ", & -! "inst_ice_ir_dir_albedo ", & -! "inst_ice_vis_dif_albedo ", & -! "inst_ice_vis_dir_albedo ", & - "mean_up_lw_flx_ice ", & - "mean_laten_heat_flx_atm_into_ice ", & - "mean_sensi_heat_flx_atm_into_ice ", & -! "mean_evap_rate ", & - "stress_on_air_ice_zonal ", & - "stress_on_air_ice_merid ", & - "mean_ice_volume ", & - "mean_snow_volume ", & - "inst_tracer_up_surface_flx ", & - "inst_tracer_down_surface_flx ", & - "inst_tracer_clmn_mass_dens ", & - "inst_tracer_anth_biom_flx ", & - "wave_z0_roughness_length " & - /) - character(len=*), public, parameter :: importFieldTypes(NimportFields) = (/ & - "t", & - "s","s","s","s","s", & - "s","s","s","s","s", & - "s","u","d","c","b", & - "s" & - /) - ! Set importFieldShare to .true. if field is provided as memory reference - ! from coupled components - logical, public, parameter :: importFieldShare(NimportFields) = (/ & - .true. , & - .false.,.false.,.false.,.false.,.false., & - .false.,.false.,.false.,.false.,.false., & - .false.,.true. ,.true. ,.true. ,.true. , & - .false. & - /) + + type(FieldInfo), dimension(NimportFields), public, parameter :: importFieldsInfo = [ & + FieldInfo("inst_tracer_mass_frac ", "t"), & + FieldInfo("land_mask ", "s"), & + FieldInfo("sea_ice_surface_temperature ", "s"), & + FieldInfo("sea_surface_temperature ", "s"), & + FieldInfo("ice_fraction ", "s"), & + FieldInfo("mean_up_lw_flx_ice ", "s"), & + FieldInfo("mean_laten_heat_flx_atm_into_ice ", "s"), & + FieldInfo("mean_sensi_heat_flx_atm_into_ice ", "s"), & + FieldInfo("stress_on_air_ice_zonal ", "s"), & + FieldInfo("stress_on_air_ice_merid ", "s"), & + FieldInfo("mean_ice_volume ", "s"), & + FieldInfo("mean_snow_volume ", "s"), & + FieldInfo("inst_tracer_up_surface_flx ", "u"), & + FieldInfo("inst_tracer_down_surface_flx ", "d"), & + FieldInfo("inst_tracer_clmn_mass_dens ", "c"), & + FieldInfo("inst_tracer_anth_biom_flx ", "b"), & + FieldInfo("wave_z0_roughness_length ", "s"), & + + ! For JEDI + ! dynamics + FieldInfo("u ", "l"), & + FieldInfo("v ", "l"), & + FieldInfo("ua ", "l"), & + FieldInfo("va ", "l"), & + FieldInfo("t ", "l"), & + FieldInfo("delp ", "l"), & + FieldInfo("sphum ", "l"), & + FieldInfo("ice_wat ", "l"), & + FieldInfo("liq_wat ", "l"), & + FieldInfo("o3mr ", "l"), & + FieldInfo("phis ", "s"), & + FieldInfo("u_srf ", "s"), & + FieldInfo("v_srf ", "s"), & + ! physics + FieldInfo("slmsk ", "s"), & + FieldInfo("weasd ", "s"), & + FieldInfo("tsea ", "s"), & + FieldInfo("vtype ", "s"), & + FieldInfo("stype ", "s"), & + FieldInfo("vfrac ", "s"), & + FieldInfo("stc ", "g"), & + FieldInfo("smc ", "g"), & + FieldInfo("snwdph ", "s"), & + FieldInfo("f10m ", "s"), & + FieldInfo("zorl ", "s"), & + FieldInfo("t2m ", "s") ] ! Methods - public fillExportFields - public queryFieldList + public queryImportFields, queryExportFields public cplFieldGet !----------------------------------------------------------------------------- contains !----------------------------------------------------------------------------- + integer function queryExportFields(fieldname, abortflag) - subroutine fillExportFields(data_a2oi, rc) - ! Fill updated data into the export Fields. - real(kind=8), target, intent(in) :: data_a2oi(:,:,:) - integer, intent(out), optional :: rc - - integer :: localrc - integer :: n,dimCount - logical :: isCreated - type(ESMF_TypeKind_Flag) :: datatype - character(len=ESMF_MAXSTR) :: fieldName - real(kind=ESMF_KIND_R4), dimension(:,:), pointer :: datar42d - real(kind=ESMF_KIND_R8), dimension(:,:), pointer :: datar82d - -! - if (present(rc)) rc=ESMF_SUCCESS + character(len=*),intent(in) :: fieldname + logical, optional :: abortflag - do n=1, size(exportFields) - isCreated = ESMF_FieldIsCreated(exportFields(n), rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - if (isCreated) then -! set data - call ESMF_FieldGet(exportFields(n), name=fieldname, dimCount=dimCount, typekind=datatype, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - !print *,'in fillExportFields, field created n=',n,size(exportFields),'name=', trim(fieldname) - if ( datatype == ESMF_TYPEKIND_R8) then - if ( dimCount == 2) then - call ESMF_FieldGet(exportFields(n),farrayPtr=datar82d,localDE=0, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - datar82d = data_a2oi(:,:,n) - endif - else if ( datatype == ESMF_TYPEKIND_R4) then - if ( dimCount == 2) then - call ESMF_FieldGet(exportFields(n),farrayPtr=datar82d,localDE=0, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - datar42d = data_a2oi(:,:,n) - endif - endif - endif - enddo - end subroutine fillExportFields -! -!------------------------------------------------------------------------------ -! - integer function queryFieldList(fieldlist, fieldname, abortflag, rc) + queryExportFields = queryFieldList(exportFieldsInfo, fieldname, abortflag) + + end function queryExportFields + + integer function queryImportFields(fieldname, abortflag) + + character(len=*),intent(in) :: fieldname + logical, optional :: abortflag + + queryImportFields = queryFieldList(importFieldsInfo, fieldname, abortflag) + + end function queryImportFields + + + integer function queryFieldList(fieldsInfo, fieldname, abortflag) ! returns integer index of first found fieldname in fieldlist ! by default, will abort if field not found, set abortflag to false ! to turn off the abort. ! return value of < 1 means the field was not found - character(len=*),intent(in) :: fieldlist(:) + type(FieldInfo) ,intent(in) :: fieldsInfo(:) character(len=*),intent(in) :: fieldname logical, optional :: abortflag - integer, optional :: rc integer :: n logical :: labort + integer :: rc labort = .true. if (present(abortflag)) then @@ -257,8 +223,8 @@ integer function queryFieldList(fieldlist, fieldname, abortflag, rc) queryFieldList = 0 n = 1 - do while (queryFieldList < 1 .and. n <= size(fieldlist)) - if (trim(fieldlist(n)) == trim(fieldname)) then + do while (queryFieldList < 1 .and. n <= size(fieldsInfo)) + if (trim(fieldsInfo(n)%name) == trim(fieldname)) then queryFieldList = n else n = n + 1 diff --git a/fv3_cap.F90 b/fv3_cap.F90 index 185f5cfea..dce7ed6c7 100644 --- a/fv3_cap.F90 +++ b/fv3_cap.F90 @@ -27,7 +27,7 @@ module fv3gfs_cap_mod nfhmax, nfhmax_hf,output_hfmax, & output_interval,output_interval_hf, & alarm_output_hf, alarm_output, & - calendar, calendar_type, cpl, & + calendar, calendar_type, & force_date_from_configure, & cplprint_flag,output_1st_tstep_rst, & first_kdt,num_restart_interval @@ -54,17 +54,14 @@ module fv3gfs_cap_mod use module_wrt_grid_comp, only: wrtSS => SetServices ! - use module_cplfields, only: nExportFields, exportFields, & - exportFieldsList, exportFieldTypes, & - exportFieldShare, & - nImportFields, importFields, & - importFieldsList, importFieldTypes, & - importFieldShare, importFieldsValid, & - queryFieldList, fillExportFields, & - exportData + use module_cplfields, only: nExportFields, exportFields, exportFieldsInfo, & + nImportFields, importFields, importFieldsInfo, & + importFieldsValid, queryImportFields + use module_cap_cpl, only: realizeConnectedCplFields, & clock_cplIntval, diagnose_cplFields + use atmos_model_mod, only: setup_exportdata implicit none private @@ -280,14 +277,14 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! 'petcount=',petcount,'mype=',mype ! ! create an instance clock for fv3 - clock_fv3 = ESMF_ClockCreate(clock, rc=RC) + clock_fv3 = ESMF_ClockCreate(clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! !------------------------------------------------------------------------ ! get config variables ! - CF = ESMF_ConfigCreate(rc=RC) - CALL ESMF_ConfigLoadFile(config=CF ,filename='model_configure' ,rc=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 ! num_restart_interval = ESMF_ConfigGetLen(config=CF, label ='restart_interval:',rc=rc) @@ -297,7 +294,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) allocate(restart_interval(num_restart_interval)) restart_interval = 0 CALL ESMF_ConfigGetAttribute(CF,valueList=restart_interval,label='restart_interval:', & - count=num_restart_interval, rc=RC) + count=num_restart_interval, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if(mype == 0) print *,'af nems config,restart_interval=',restart_interval ! @@ -305,9 +302,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) label ='calendar:', & default='gregorian',rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! - CALL ESMF_ConfigGetAttribute(config=CF,value=cpl,default=.false.,label ='cpl:',rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! CALL ESMF_ConfigGetAttribute(config=CF,value=quilting, & label ='quilting:',rc=rc) @@ -326,7 +320,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_ConfigGetAttribute(config=CF,value=ichunk3d,default=0,label ='ichunk3d:',rc=rc) call ESMF_ConfigGetAttribute(config=CF,value=jchunk3d,default=0,label ='jchunk3d:',rc=rc) call ESMF_ConfigGetAttribute(config=CF,value=kchunk3d,default=0,label ='kchunk3d:',rc=rc) - + ! zlib compression flag call ESMF_ConfigGetAttribute(config=CF,value=ideflate,default=0,label ='ideflate:',rc=rc) if (ideflate < 0) ideflate=0 @@ -367,7 +361,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! allocate(filename_base(num_files)) - CALL ESMF_ConfigFindLabel(CF,'filename_base:',rc=RC) + CALL ESMF_ConfigFindLabel(CF,'filename_base:',rc=rc) do i=1,num_files CALL ESMF_ConfigGetAttribute(config=CF,value=filename_base(i), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -378,7 +372,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (num_files == num_output_file) then CALL ESMF_ConfigGetAttribute(CF,valueList=output_file,label='output_file:', & - count=num_files, rc=RC) + count=num_files, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return do i = 1, num_files if(output_file(i) /= "netcdf" .and. output_file(i) /= "netcdf_parallel") then @@ -387,7 +381,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) endif enddo else if ( num_output_file == 1) then - CALL ESMF_ConfigGetAttribute(CF,valuelist=output_file,label='output_file:', count=1, rc=RC) + CALL ESMF_ConfigGetAttribute(CF,valuelist=output_file,label='output_file:', count=1, rc=rc) output_file(1:num_files) = output_file(1) else output_file(1:num_files) = 'netcdf' @@ -529,31 +523,29 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) stopTime=stopTime, timeStep=timeStep, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + ! !Under NUOPC, the EARTH driver clock is a separate instance from the ! - fv3 clock. However, the fv3 clock may have been reset from restart ! - therefore the EARTH driver clock must also be adjusted. ! - Affected: currTime, timeStep - call ESMF_ClockGet(clock, timeStep=earthStep, rc=RC) + call ESMF_ClockGet(clock, timeStep=earthStep, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) if (earthStep > (stopTime-currTime)) earthStep = stopTime - currTime - call ESMF_ClockSet(clock, currTime=currTime, timeStep=earthStep, rc=RC) + call ESMF_ClockSet(clock, currTime=currTime, timeStep=earthStep, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) ! Set fv3 component clock as copy of EARTH clock. - call NUOPC_CompSetClock(gcomp, clock, rc=RC) + call NUOPC_CompSetClock(gcomp, clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) ! Read in the FV3 coupling interval - if ( cpl ) then - call clock_cplIntval(gcomp, CF) - endif -! + call clock_cplIntval(gcomp, CF) + first_kdt = 1 if( output_1st_tstep_rst) then rsthour = CurrTime - StartTime @@ -871,39 +863,23 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! ! --- advertise Fields in importState and exportState ------------------- - if( cpl ) then + ! importable fields: + do i = 1, size(importFieldsInfo) + call NUOPC_Advertise(importState, & + StandardName=trim(importFieldsInfo(i)%name), & + SharePolicyField='share', vm=fcstVM, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + end do - ! importable fields: - do i = 1, size(ImportFieldsList) - if (importFieldShare(i)) then - call NUOPC_Advertise(importState, & - StandardName=trim(ImportFieldsList(i)), & - SharePolicyField="share", vm=fcstVM, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - else - call NUOPC_Advertise(importState, & - StandardName=trim(ImportFieldsList(i)), vm=fcstVM, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - end if - end do - - ! exportable fields: - do i = 1, size(exportFieldsList) - if (exportFieldShare(i)) then - call NUOPC_Advertise(exportState, & - StandardName=trim(exportFieldsList(i)), & - SharePolicyField="share", vm=fcstVM, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - else - call NUOPC_Advertise(exportState, & - StandardName=trim(exportFieldsList(i)), vm=fcstVM, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - end if - end do - - if(mype==0) print *,'in fv3_cap, aft import, export fields in atmos' - endif + ! exportable fields: + do i = 1, size(exportFieldsInfo) + call NUOPC_Advertise(exportState, & + StandardName=trim(exportFieldsInfo(i)%name), & + SharePolicyField='share', vm=fcstVM, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + end do + if(mype==0) print *,'in fv3_cap, aft import, export fields in atmos' if(mype==0) print *,'in fv3_cap, init time=',mpi_wtime()-timeis !----------------------------------------------------------------------- ! @@ -918,6 +894,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer, intent(out) :: rc ! local variables + character(len=*),parameter :: subname='(fv3gfs_cap:InitializeRealize)' logical :: isPetLocal integer :: n @@ -925,33 +902,31 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! --- conditionally realize or remove Fields in importState and exportState ------------------- - if ( cpl ) then + isPetLocal = ESMF_GridCompIsPetLocal(fcstComp, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - isPetLocal = ESMF_GridCompIsPetLocal(fcstComp, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (isPetLocal) then - if (isPetLocal) then + ! -- realize connected fields in exportState + call realizeConnectedCplFields(exportState, fcstGrid, & + numLevels, numSoilLayers, numTracers, num_diag_sfc_emis_flux, & + num_diag_down_flux, num_diag_type_down_flux, num_diag_burn_emis_flux, & + num_diag_cmass, exportFieldsInfo, 'FV3 Export', & + exportFields, rc) - ! -- realize connected fields in exportState - call realizeConnectedCplFields(exportState, fcstGrid, & - numLevels, numSoilLayers, numTracers, num_diag_sfc_emis_flux, & - num_diag_down_flux, num_diag_type_down_flux, num_diag_burn_emis_flux, & - num_diag_cmass, exportFieldsList, exportFieldTypes, 'FV3 Export', & - exportFields, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! -- realize connected fields in importState + call realizeConnectedCplFields(importState, fcstGrid, & + numLevels, numSoilLayers, numTracers, num_diag_sfc_emis_flux, & + num_diag_down_flux, num_diag_type_down_flux, num_diag_burn_emis_flux, & + num_diag_cmass, importFieldsInfo, 'FV3 Import', & + importFields, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - ! -- realize connected fields in importState - call realizeConnectedCplFields(importState, fcstGrid, & - numLevels, numSoilLayers, numTracers, num_diag_sfc_emis_flux, & - num_diag_down_flux, num_diag_type_down_flux, num_diag_burn_emis_flux, & - num_diag_cmass, importFieldsList, importFieldTypes, 'FV3 Import', & - importFields, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - end if -!jw - call fillExportFields(exportData) - endif + call setup_exportdata() + + end if end subroutine InitializeRealize @@ -960,27 +935,23 @@ end subroutine InitializeRealize subroutine ModelAdvance(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - + ! local variables - type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock type(ESMF_Time) :: currTime type(ESMF_TimeInterval) :: timeStep type(ESMF_Time) :: startTime, stopTime type(ESMF_TimeInterval) :: time_elapsed - integer(ESMF_KIND_I8) :: n_interval, time_elapsed_sec ! integer :: na, i, urc logical :: fcstpe - logical :: isAlarmEnabled, isAlarmRinging, lalarm, reconcileFlag + logical :: isAlarmEnabled, isAlarmRinging, lalarm character(len=*),parameter :: subname='(fv3_cap:ModelAdvance)' character(240) :: msgString - character(240) :: import_timestr, export_timestr + character(240) :: startTime_str, currTime_str, stopTime_str, timeStep_str !jw debug character(ESMF_MAXSTR) :: name - integer :: mype,date(6), fieldcount, fcst_nfld - real(kind=ESMF_KIND_R4), pointer :: dataPtr(:,:,:), dataPtr2d(:,:) - character(64) :: fcstbdl_name + integer :: mype real(kind=8) :: MPI_Wtime real(kind=8) :: timeri, timewri, timewr, timerhi, timerh @@ -989,7 +960,7 @@ subroutine ModelAdvance(gcomp, rc) rc = ESMF_SUCCESS - if (profile_memory) call ESMF_VMLogMemInfo("Entering FV3 Model_ADVANCE: ") + if (profile_memory) call ESMF_VMLogMemInfo("Entering FV3 ModelAdvance: ") timeri = mpi_wtime() ! @@ -1005,7 +976,7 @@ subroutine ModelAdvance(gcomp, rc) ! multiple calls to the ModelAdvance() routine. Every time the currTime ! will come in by one internal timeStep advanced. This goes until the ! stopTime of the internal Clock has been reached. - + call ESMF_ClockPrint(clock_fv3, options="currTime", & preString="------>Advancing FV3 from: ", unit=msgString, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -1046,29 +1017,15 @@ subroutine ModelAdvance(gcomp, rc) timeStep=timeStep, stopTime=stopTime, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! if(mype==0) print *,'total steps=', nint((stopTime-startTime)/timeStep) -! if(mype==lead_wrttask(1)) print *,'on wrt lead,total steps=', nint((stopTime-startTime)/timeStep) - call ESMF_TimeGet(time=stopTime,yy=date(1),mm=date(2),dd=date(3),h=date(4), & - m=date(5),s=date(6),rc=rc) -! if(mype==0) print *,'af clock,stop date=',date -! if(mype==lead_wrttask(1)) print *,'on wrt lead,af clock,stop date=',date - call ESMF_TimeIntervalGet(timeStep,yy=date(1),mm=date(2),d=date(3),h=date(4), & - m=date(5),s=date(6),rc=rc) -! if(mype==0) print *,'af clock,timestep date=',date -! if(mype==lead_wrttask(1)) print *,'on wrt lead,af clock,timestep date=',date -! - call ESMF_ClockGet(clock_fv3, currTime=currTime, timeStep=timeStep, rc=rc) - call ESMF_TimeGet(currTime, timestring=import_timestr, rc=rc) - call ESMF_TimeGet(currTime+timestep, timestring=export_timestr, rc=rc) + ! call ESMF_TimeGet(startTime, timestring=startTime_str, rc=rc) + ! call ESMF_TimeGet(currTime, timestring=currTime_str, rc=rc) + ! call ESMF_TimeGet(stopTime, timestring=stopTime_str, rc=rc) + ! call ESMF_TimeIntervalGet(timeStep, timestring=timeStep_str, rc=rc) ! !----------------------------------------------------------------------------- !*** integration loop - reconcileFlag = .true. - call esmf_clockget(clock_fv3, timestep=timestep, starttime=starttime, & - currtime=currtime, rc=rc) - integrate: do while(.NOT.ESMF_ClockIsStopTime(clock_fv3, rc = RC)) ! !*** for forecast tasks @@ -1083,12 +1040,9 @@ subroutine ModelAdvance(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - if ( cpl ) then - ! assign import_data called during phase=1 - if( dbug > 0 .or. cplprint_flag ) then - call diagnose_cplFields(gcomp, importState, exportstate, clock_fv3, & - fcstpe, cplprint_flag, dbug, 'import', import_timestr) - endif + ! assign import_data called during phase=1 + if( dbug > 0 .or. cplprint_flag ) then + call diagnose_cplFields(gcomp, clock_fv3, fcstpe, cplprint_flag, dbug, 'import') endif call ESMF_GridCompRun(fcstComp, exportState=fcstState, clock=clock_fv3, & @@ -1151,7 +1105,7 @@ subroutine ModelAdvance(gcomp, rc) timerhi = mpi_wtime() ! if (mype == 0 .or. mype == lead_wrttask(1)) print *,' aft fcst run alarm is on, na=',na,'mype=',mype - + call ESMF_VMEpochEnter(epoch=ESMF_VMEpoch_Buffer, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -1203,24 +1157,17 @@ subroutine ModelAdvance(gcomp, rc) ! end quilting endif -! if (mype == 0 .or. mype == 1536 .or. mype==2160) then -! print *,'fv3_cap,end integrate,na=',na,' time=',mpi_wtime()- timewri -! endif + if( dbug > 0 .or. cplprint_flag ) then + call diagnose_cplFields(gcomp, clock_fv3, fcstpe, cplprint_flag, dbug, 'export') + end if + !*** end integreate loop enddo integrate ! -!jw for coupled, check clock and dump import and export state - if ( cpl ) then - if( dbug > 0 .or. cplprint_flag ) then - call diagnose_cplFields(gcomp, importState, exportstate, clock_fv3, & - fcstpe, cplprint_flag, dbug, 'export', export_timestr) - end if - endif - if (mype==0) print *,'fv3_cap,end integrate,na=',na,' time=',mpi_wtime()- timeri - if (profile_memory) call ESMF_VMLogMemInfo("Leaving FV3 Model_ADVANCE: ") + if (profile_memory) call ESMF_VMLogMemInfo("Leaving FV3 ModelAdvance: ") end subroutine ModelAdvance @@ -1229,25 +1176,21 @@ end subroutine ModelAdvance subroutine ModelAdvance_phase1(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - + ! local variables type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock type(ESMF_Time) :: currTime type(ESMF_TimeInterval) :: timeStep type(ESMF_Time) :: startTime, stopTime - type(ESMF_TimeInterval) :: time_elapsed - integer(ESMF_KIND_I8) :: n_interval, time_elapsed_sec ! integer :: na, i, urc - logical :: lalarm, reconcileFlag + logical :: lalarm character(len=*),parameter :: subname='(fv3_cap:ModelAdvance_phase1)' character(240) :: msgString !jw debug character(ESMF_MAXSTR) :: name - integer :: mype,date(6), fieldcount, fcst_nfld - real(kind=ESMF_KIND_R4), pointer :: dataPtr(:,:,:), dataPtr2d(:,:) - character(64) :: fcstbdl_name + integer :: mype,date(6) real(kind=8) :: MPI_Wtime real(kind=8) :: timewri, timewr, timerhi, timerh @@ -1255,7 +1198,7 @@ subroutine ModelAdvance_phase1(gcomp, rc) rc = ESMF_SUCCESS - if(profile_memory) call ESMF_VMLogMemInfo("Entering FV3 Model_ADVANCE phase1: ") + if(profile_memory) call ESMF_VMLogMemInfo("Entering FV3 ModelAdvance_phase1: ") ! call ESMF_GridCompGet(gcomp, name=name, localpet=mype, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -1264,14 +1207,14 @@ subroutine ModelAdvance_phase1(gcomp, rc) ! step. ! Also expecting the coupling step to be identical to the timeStep for ! clock_fv3. - + call ESMF_ClockPrint(clock_fv3, options="currTime", & preString="------>Advancing FV3 from: ", unit=msgString, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + !----------------------------------------------------------------------- !*** Use the internal Clock set by NUOPC layer for FV3 but update stopTime !----------------------------------------------------------------------- @@ -1320,8 +1263,6 @@ subroutine ModelAdvance_phase1(gcomp, rc) !----------------------------------------------------------------------------- !*** no integration loop here! - reconcileFlag = .true. - !*** for forecast tasks call ESMF_LogWrite('Model Advance phase1: before fcstcomp run ', ESMF_LOGMSG_INFO, rc=rc) @@ -1336,7 +1277,7 @@ subroutine ModelAdvance_phase1(gcomp, rc) call ESMF_LogWrite('Model Advance phase1: after fcstcomp run ', ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (profile_memory) call ESMF_VMLogMemInfo("Leaving FV3 Model_ADVANCE phase1: ") + if (profile_memory) call ESMF_VMLogMemInfo("Leaving FV3 ModelAdvance_phase1: ") end subroutine ModelAdvance_phase1 @@ -1353,25 +1294,21 @@ subroutine ModelAdvance_phase2(gcomp, rc) type(ESMF_TimeInterval) :: timeStep type(ESMF_Time) :: startTime, stopTime type(ESMF_TimeInterval) :: time_elapsed - integer(ESMF_KIND_I8) :: n_interval, time_elapsed_sec ! integer :: na, i, urc - logical :: isAlarmEnabled, isAlarmRinging, lalarm, reconcileFlag + logical :: isAlarmEnabled, isAlarmRinging, lalarm character(len=*),parameter :: subname='(fv3_cap:ModelAdvance_phase2)' character(240) :: msgString !jw debug character(ESMF_MAXSTR) :: name - integer :: mype,date(6), fieldcount, fcst_nfld - real(kind=ESMF_KIND_R4), pointer :: dataPtr(:,:,:), dataPtr2d(:,:) - character(64) :: fcstbdl_name + integer :: mype,date(6) real(kind=8) :: MPI_Wtime real(kind=8) :: timewri, timewr, timerhi, timerh !----------------------------------------------------------------------------- rc = ESMF_SUCCESS - if(profile_memory) & - call ESMF_VMLogMemInfo("Entering FV3 Model_ADVANCE phase2: ") + if(profile_memory) call ESMF_VMLogMemInfo("Entering FV3 ModelAdvance_phase2: ") ! call ESMF_GridCompGet(gcomp, name=name, localpet=mype, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -1379,8 +1316,6 @@ subroutine ModelAdvance_phase2(gcomp, rc) !----------------------------------------------------------------------------- !*** no integration loop - reconcileFlag = .true. - ! !*** for forecast tasks @@ -1513,8 +1448,7 @@ subroutine ModelAdvance_phase2(gcomp, rc) unit=nuopcMsg) call ESMF_LogWrite(nuopcMsg, ESMF_LOGMSG_INFO) - if(profile_memory) & - call ESMF_VMLogMemInfo("Leaving FV3 Model_ADVANCE phase2: ") + if(profile_memory) call ESMF_VMLogMemInfo("Leaving FV3 ModelAdvance_phase2: ") end subroutine ModelAdvance_phase2 @@ -1527,6 +1461,7 @@ subroutine fv3_checkimport(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc ! + character(len=*),parameter :: subname='(fv3gfs_cap:fv3_checkimport)' integer :: n, nf type(ESMF_Clock) :: clock type(ESMF_Time) :: currTime, invalidTime @@ -1574,7 +1509,7 @@ subroutine fv3_checkimport(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - nf = queryFieldList(ImportFieldsList,fldname) + nf = queryImportFields(fldname) timeCheck1 = NUOPC_IsAtTime(fieldList(n), invalidTime, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -1597,7 +1532,7 @@ subroutine fv3_checkimport(gcomp, rc) endif write(MESSAGE_CHECK,'(A,2i4,l3)') & "FV3_CHECKIMPORT "//trim(fldname),n,nf,importFieldsValid(nf) - CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC) + CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=rc) enddo endif @@ -1610,6 +1545,7 @@ subroutine TimestampExport_phase1(gcomp, rc) integer, intent(out) :: rc ! local variables + character(len=*),parameter :: subname='(fv3gfs_cap:TimestampExport_phase1)' type(ESMF_Clock) :: driverClock, modelClock type(ESMF_State) :: exportState @@ -1638,7 +1574,8 @@ subroutine atmos_model_finalize(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc ! - integer :: i, unit, date(6), mype, urc + character(len=*),parameter :: subname='(fv3gfs_cap:atmos_model_finalize)' + integer :: i, unit, mype, urc type(ESMF_VM) :: vm real(kind=8) :: MPI_Wtime, timeffs ! diff --git a/module_fcst_grid_comp.F90 b/module_fcst_grid_comp.F90 index 776a89bf4..01a9a3029 100644 --- a/module_fcst_grid_comp.F90 +++ b/module_fcst_grid_comp.F90 @@ -70,7 +70,7 @@ module module_fcst_grid_comp use module_fv3_io_def, only: num_pes_fcst, num_files, filename_base, nbdlphys, & iau_offset use module_fv3_config, only: dt_atmos, calendar, restart_interval, & - quilting, calendar_type, cpl, & + quilting, calendar_type, & cplprint_flag, force_date_from_configure, & num_restart_interval, frestart, restart_endfcst use get_stochy_pattern_mod, only: write_stoch_restart_atm @@ -535,17 +535,19 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) endif ! -!test to write out vtk file: - if( cpl ) then + !! FIXME + if ( .not. atm_int_state%Atm%nested ) then !! global only call addLsmask2grid(fcstGrid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! print *,'call addLsmask2grid after fcstGrid, rc=',rc -! if( cplprint_flag ) then -! call ESMF_GridWriteVTK(fcstGrid, staggerloc=ESMF_STAGGERLOC_CENTER, & -! filename='fv3cap_fv3Grid', rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! endif + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return +! print *,'call addLsmask2grid after fcstGrid, rc=',rc endif + +!test to write out vtk file: +! if( cplprint_flag ) then +! call ESMF_GridWriteVTK(fcstGrid, staggerloc=ESMF_STAGGERLOC_CENTER, & +! filename='fv3cap_fv3Grid', rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return +! endif ! ! Add gridfile Attribute to the exportState call ESMF_AttributeAdd(exportState, convention="NetCDF", purpose="FV3", & diff --git a/module_fv3_config.F90 b/module_fv3_config.F90 index e5940d514..8b7d83b77 100644 --- a/module_fv3_config.F90 +++ b/module_fv3_config.F90 @@ -22,7 +22,7 @@ module module_fv3_config type(ESMF_TimeInterval) :: output_hfmax type(ESMF_TimeInterval) :: output_interval,output_interval_hf ! - logical :: cpl, cplprint_flag + logical :: cplprint_flag logical :: quilting, output_1st_tstep_rst logical :: force_date_from_configure logical :: restart_endfcst