diff --git a/.circleci/config.yml b/.circleci/config.yml index 5c89ea6..5ca179e 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -1,11 +1,11 @@ version: 2.1 # Anchors in case we need to override the defaults from the orb -#baselibs_version: &baselibs_version v7.17.0 -#bcs_version: &bcs_version v11.4.0 +#baselibs_version: &baselibs_version v8.5.0 +#bcs_version: &bcs_version v12.0.0 orbs: - ci: geos-esm/circleci-tools@2 + ci: geos-esm/circleci-tools@5 workflows: build-test: @@ -17,11 +17,14 @@ workflows: - docker-hub-creds matrix: parameters: - compiler: [gfortran, ifort] + compiler: [gfortran, ifort, ifx] #baselibs_version: *baselibs_version repo: GEOSgcm checkout_fixture: true - mepodevelop: true + # V12 code uses a special branch for now. + fixture_branch: feature/sdrabenh/gcm_v12 + # We comment out this as it will "undo" the fixture_branch + #mepodevelop: true persist_workspace: true # Needs to be true to run fv3/gcm experiment, costs extra # Run AMIP GCM (1 hour, no ExtData) @@ -31,7 +34,7 @@ workflows: - docker-hub-creds matrix: parameters: - compiler: [gfortran, ifort] + compiler: [gfortran, ifort, ifx] requires: - build-GEOSgcm-on-<< matrix.compiler >> repo: GEOSgcm @@ -45,7 +48,7 @@ workflows: - docker-hub-creds matrix: parameters: - compiler: [gfortran, ifort] + compiler: [ifort] requires: - build-GEOSgcm-on-<< matrix.compiler >> repo: GEOSgcm diff --git a/GEOSsolar_GridComp/GEOS_SolarGridComp.F90 b/GEOSsolar_GridComp/GEOS_SolarGridComp.F90 index 88e01d2..0490170 100644 --- a/GEOSsolar_GridComp/GEOS_SolarGridComp.F90 +++ b/GEOSsolar_GridComp/GEOS_SolarGridComp.F90 @@ -2,10 +2,10 @@ #define LIN2_ARG1(VAR,I,J,FINT) (VAR(I,J) + FINT * (VAR(I+1,J)-VAR(I,J))) ! ============================================================================== -! Note: the SOLAR_RADVAL compile time flag (enabled with the ENABLE_SOLAR_RADVAL +! Note: the SOLAR_RADVAL compile time flag (enabled with the ENABLE_SOLAR_RADVAL ! CMake option) is used to select solar diagnostic features which are generally ! more advanced than what a regular user will need and mainly for use by the -! the radiation code development team. They are chosen by compile time flag +! the radiation code development team. They are chosen by compile time flag ! because they bloat the restart state and may also incur other computational ! costs that are not warranted under normal (non-development) use. ! ============================================================================== @@ -167,6 +167,7 @@ module GEOS_SolarGridCompMod use ESMF use MAPL + use gFTL_StringVector ! for RRTMGP use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp @@ -472,7 +473,7 @@ subroutine SetServices ( GC, RC ) type (ty_RRTMGP_wrap) :: wrap ! for OSRBbbRG, ISRBbbRG, and TBRBbbRG - integer :: ibnd + integer :: ibnd character*2 :: bb !============================================================================= @@ -520,7 +521,7 @@ subroutine SetServices ( GC, RC ) ! Decide if should make OBIO exports call MAPL_GetResource ( MAPL, DO_OBIO, Label="USE_OCEANOBIOGEOCHEM:",DEFAULT=0, RC=STATUS) VERIFY_(STATUS) - + SOLAR_TO_OBIO = (DO_OBIO/=0) ! Set the state variable specs. @@ -789,21 +790,21 @@ subroutine SetServices ( GC, RC ) do ibnd = 1,nbndsw if (band_output_supported(ibnd)) then write(bb,'(I0.2)') ibnd - + call MAPL_AddInternalSpec(GC, & SHORT_NAME = 'OSRB'//bb//'RGN', & LONG_NAME = 'normalized_upwelling_shortwave_flux_at_TOA_in_RR_band'//bb, & UNITS = '1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, __RC__ ) - + call MAPL_AddInternalSpec(GC, & SHORT_NAME = 'ISRB'//bb//'RGN', & LONG_NAME = 'normalized_downwelling_shortwave_flux_at_TOA_in_RR_band'//bb, & UNITS = '1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, __RC__ ) - + end if end do end if @@ -1474,7 +1475,7 @@ subroutine SetServices ( GC, RC ) VLOCATION = MAPL_VLocationNone, & FRIENDLYTO = trim(COMP_NAME), __RC__) - ! super-layerized phase-split cloud SSA and ASM + ! super-layerized phase-split cloud SSA and ASM call MAPL_AddInternalSpec(GC, & SHORT_NAME = 'SSALDENLOPAR', & @@ -2667,28 +2668,28 @@ subroutine SetServices ( GC, RC ) do ibnd = 1,nbndsw if (band_output_supported(ibnd)) then write(bb,'(I0.2)') ibnd - + call MAPL_AddExportSpec(GC, & SHORT_NAME = 'OSRB'//bb//'RG', & LONG_NAME = 'upwelling_shortwave_flux_at_TOA_in_RR_band'//bb, & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, __RC__ ) - + call MAPL_AddExportSpec(GC, & SHORT_NAME = 'ISRB'//bb//'RG', & LONG_NAME = 'downwelling_shortwave_flux_at_TOA_in_RR_band'//bb, & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, __RC__ ) - + call MAPL_AddExportSpec(GC, & SHORT_NAME = 'TBRB'//bb//'RG', & LONG_NAME = 'brightness_temperature_in_RR_SW_band'//bb, & UNITS = 'K', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, __RC__ ) - + end if end do end if @@ -2952,18 +2953,15 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) logical :: do_no_aero_calc - ! list of strings facility - integer :: i - type S_ - character(len=:), allocatable :: str - end type S_ - type(S_), allocatable :: list(:) + type(StringVector) :: string_vec + type(StringVectorIterator) :: string_vec_iter + character(len=:), pointer :: string_pointer ! which bands require OSR output? ! (only RRTMG[P]; OSRBbbRG, ISRBbbRG, and TBRBbbRG) logical :: band_output (nbndsw) integer :: ibnd - character*2 :: bb + character*2 :: bb !============================================================================= @@ -3072,7 +3070,7 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) _FAIL('Total number of radiation bands is inconsistent!') end if - ! select which bands require OSRB output ... + ! select which bands require OSRB output ... ! ------------------------------------------ ! Only available for RRTMG[P] ! Must be supported AND requested by exports 'OSRBbbRG', 'ISRBbbRG', or 'TBRBbbRG' @@ -3082,16 +3080,16 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) if (.not. band_output_supported(ibnd)) cycle write(bb,'(I0.2)') ibnd call MAPL_GetPointer(EXPORT, ptr2d, 'OSRB'//bb//'RG', __RC__) - if (associated(ptr2d)) then + if (associated(ptr2d)) then band_output(ibnd) = .true. cycle - end if + end if call MAPL_GetPointer(EXPORT, ptr2d, 'ISRB'//bb//'RG', __RC__) - if (associated(ptr2d)) then + if (associated(ptr2d)) then band_output(ibnd) = .true. cycle - end if - call MAPL_GetPointer(EXPORT, ptr2d, 'TBRB'//bb//'RG', __RC__) + end if + call MAPL_GetPointer(EXPORT, ptr2d, 'TBRB'//bb//'RG', __RC__) if (associated(ptr2d)) then band_output(ibnd) = .true. cycle @@ -3359,27 +3357,50 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Optional without-aerosol diagnostics ! ------------------------------------ - ! this line temporarily needed because of compiler bug - allocate(list(1)); list(1) = S_('dummy') - ! are without-aerosol exports requested? do_no_aero_calc = .false. - list = [S_('FSWNA'), S_('FSWUNA'), S_('FSWDNA'), & - S_('FSCNA'), S_('FSCUNA'), S_('FSCDNA'), & - S_('FSWBANDNA')] - do i = 1, size(list) - call MAPL_GetPointer( EXPORT, ptr3d, list(i)%str, __RC__) - do_no_aero_calc = (do_no_aero_calc .or. associated(ptr3d)) - end do - list = [S_('RSRNA'), S_('RSRSNA'), S_('OSRNA') , & - S_('RSCNA'), S_('RSCSNA'), S_('OSRCNA'), & - S_('SLRSFNA'), S_('SLRSUFNA'), & - S_('SLRSFCNA'), S_('SLRSUFCNA')] - do i = 1, size(list) - call MAPL_GetPointer( EXPORT, ptr2d, list(i)%str, __RC__) - do_no_aero_calc = (do_no_aero_calc .or. associated(ptr2d)) + + call string_vec%push_back('FSWNA') + call string_vec%push_back('FSWUNA') + call string_vec%push_back('FSWDNA') + call string_vec%push_back('FSCNA') + call string_vec%push_back('FSCUNA') + call string_vec%push_back('FSCDNA') + call string_vec%push_back('FSWBANDNA') + + string_vec_iter = string_vec%begin() + do while ( string_vec_iter /= string_vec%end() ) + string_pointer => string_vec_iter%get() + call MAPL_GetPointer( EXPORT, ptr3d, string_pointer, __RC__) + do_no_aero_calc = (do_no_aero_calc .or. associated(ptr3d)) + call string_vec_iter%next() end do + if (.not. do_no_aero_calc) then + + call string_vec%clear() + + call string_vec%push_back('RSRNA') + call string_vec%push_back('RSRSNA') + call string_vec%push_back('OSRNA') + call string_vec%push_back('RSCNA') + call string_vec%push_back('RSCSNA') + call string_vec%push_back('OSRCNA') + call string_vec%push_back('SLRSFNA') + call string_vec%push_back('SLRSUFNA') + call string_vec%push_back('SLRSFCNA') + call string_vec%push_back('SLRSUFCNA') + + string_vec_iter = string_vec%begin() + + do while ( string_vec_iter /= string_vec%end() ) + string_pointer => string_vec_iter%get() + call MAPL_GetPointer( EXPORT, ptr2d, string_pointer, __RC__) + do_no_aero_calc = (do_no_aero_calc .or. associated(ptr2d)) + call string_vec_iter%next() + end do + end if + if (do_no_aero_calc) then ! do a calculation without aerosols: @@ -3394,11 +3415,19 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) else ! otherwise, zero the no-aerosol internals - list = [S_('FSWNAN'), S_('FSWUNAN'), & - S_('FSCNAN'), S_('FSCUNAN'), S_('FSWBANDNAN')] - do i = 1, size(list) - call MAPL_GetPointer( INTERNAL, ptr3d, list(i)%str, __RC__) - ptr3d = 0. + call string_vec%clear() + + call string_vec%push_back('FSWNAN') + call string_vec%push_back('FSWUNAN') + call string_vec%push_back('FSCNAN') + call string_vec%push_back('FSCUNAN') + call string_vec%push_back('FSWBANDNAN') + string_vec_iter = string_vec%begin() + do while ( string_vec_iter /= string_vec%end() ) + string_pointer => string_vec_iter%get() + call MAPL_GetPointer( INTERNAL, ptr3d, string_pointer, __RC__) + ptr3d = 0. + call string_vec_iter%next() end do end if @@ -3643,7 +3672,7 @@ subroutine SORADCORE(IM,JM,LM,include_aerosols,CURRTIME,MaxPasses,LoadBalance,RC ! PMN: my earlier RRTMGP implementations used cloud_props for liq and ice combined, ! but now, to allow separate delta-scaling for the two phases, we keep separate liq and - ! ice properties, and combine them later. There may be some speedup possible here, but + ! ice properties, and combine them later. There may be some speedup possible here, but ! to allow for future more independent phases (e.g., separate condensate inhomogeneity ! for the phases), we keep the phase optical properties separate as long as possible. @@ -4068,7 +4097,7 @@ subroutine SORADCORE(IM,JM,LM,include_aerosols,CURRTIME,MaxPasses,LoadBalance,RC QR => ptr2(1:Num2do,:) case('QS') QS => ptr2(1:Num2do,:) - case('QG') + case('QG') QG => ptr2(1:Num2do,:) case('RL') RL => ptr2(1:Num2do,:) @@ -4731,7 +4760,7 @@ subroutine SORADCORE(IM,JM,LM,include_aerosols,CURRTIME,MaxPasses,LoadBalance,RC WHERE (RL == MAPL_UNDEF) RL = 14.e-6 WHERE (RR == MAPL_UNDEF) RR = 50.e-6 WHERE (RS == MAPL_UNDEF) RS = 50.e-6 - WHERE (RG == MAPL_UNDEF) RG = 50.e-6 + WHERE (RG == MAPL_UNDEF) RG = 50.e-6 RR3(:,:,1) = RI*1.e6 RR3(:,:,2) = RL*1.e6 RR3(:,:,3) = RR*1.e6 @@ -5381,7 +5410,7 @@ subroutine SORADCORE(IM,JM,LM,include_aerosols,CURRTIME,MaxPasses,LoadBalance,RC ! liquid ... error_msg = cloud_optics%cloud_optics( & real(QQ3(colS:colE,:,2),kind=wp) * dp_wp(colS:colE,:) * cwp_fac, & ! [g/m2] - dummy_wp(colS:colE,:), & + dummy_wp(colS:colE,:), & min( max( real(RR3(colS:colE,:,2),kind=wp), & ! [microns] cloud_optics%get_min_radius_liq()), & cloud_optics%get_max_radius_liq()), & @@ -5548,7 +5577,7 @@ subroutine SORADCORE(IM,JM,LM,include_aerosols,CURRTIME,MaxPasses,LoadBalance,RC icol = colS + isub - 1 #ifdef SOLAR_RADVAL - ! default (no cloud) for TAUx variant + ! default (no cloud) for TAUx variant TAUTP(icol) = 0. TAUHP(icol) = 0. TAUMP(icol) = 0. @@ -5587,7 +5616,7 @@ subroutine SORADCORE(IM,JM,LM,include_aerosols,CURRTIME,MaxPasses,LoadBalance,RC ! accumulate over gpts/subcolumns do ib = 1, nbnd do igpt = band_lims_gpt(1,ib), band_lims_gpt(2,ib) - + ! band weights for photosynthetically active radiation (PAR) ! Bands 11-12 (0.345-0.625 um) plus half transition band 10 (0.625-0.778 um) if (ib >= 11 .and. ib <= 12) then @@ -5804,7 +5833,7 @@ subroutine SORADCORE(IM,JM,LM,include_aerosols,CURRTIME,MaxPasses,LoadBalance,RC #endif end if - end if ! potentially cloudy column + end if ! potentially cloudy column end do ! isub end if ! include_aerosols call MAPL_TimerOff(MAPL,"--RRTMGP_SPRLYR_DIAGS",__RC__) @@ -5832,7 +5861,7 @@ subroutine SORADCORE(IM,JM,LM,include_aerosols,CURRTIME,MaxPasses,LoadBalance,RC do ilay = 1,LM ! only if at least potentially cloudy ... if (CL(icol,ilay) > 0.) then - + ! prepare for radice interpolation ... ! first get radice consistent with RRTMGP ice cloud optics radice = min(max(real(RR3(icol,ilay,1),kind=wp),radice_lwr),radice_upr) @@ -5843,11 +5872,11 @@ subroutine SORADCORE(IM,JM,LM,include_aerosols,CURRTIME,MaxPasses,LoadBalance,RC radfac = (radice - 2._wp) / 3._wp radidx = min(max(int(radfac),1),45) rfint = radfac - real(radidx,kind=wp) - + do ib = 1,nbnd ! interpolate fdelta in radice for band ib fdelta = LIN2_ARG1(fdlice3_rrtmgp,radidx,ib,rfint) - + ! forwice calc for each g-point do igpt = band_lims_gpt(1,ib),band_lims_gpt(2,ib) if (cloud_props_gpt_ice%tau(isub,ilay,igpt) > 0.) then @@ -5857,7 +5886,7 @@ subroutine SORADCORE(IM,JM,LM,include_aerosols,CURRTIME,MaxPasses,LoadBalance,RC endif enddo ! g-points enddo ! bands - + endif ! potentially cloudy enddo ! layers enddo ! columns @@ -6221,10 +6250,10 @@ subroutine SORADCORE(IM,JM,LM,include_aerosols,CURRTIME,MaxPasses,LoadBalance,RC end do endif ! TOA band fluxes - if (include_aerosols) then + if (include_aerosols) then if (USE_RRTMG .or. USE_RRTMGP) then do ib = 1, nbnd - if (band_output(ib)) then + if (band_output(ib)) then ISRBRGN(ib) % p = real(bnd_flux_dn_allsky(:,1,ib)) OSRBRGN(ib) % p = real(bnd_flux_dn_allsky(:,1,ib) - bnd_flux_net_allsky(:,1,ib)) end if @@ -6341,9 +6370,9 @@ subroutine SORADCORE(IM,JM,LM,include_aerosols,CURRTIME,MaxPasses,LoadBalance,RC call MAPL_GetResource(MAPL,ICEFLGSW,'RRTMG_ICEFLG:',DEFAULT=3,__RC__) call MAPL_GetResource(MAPL,LIQFLGSW,'RRTMG_LIQFLG:',DEFAULT=1,__RC__) - if (LM > 72) then + if (LM > 72) then call MAPL_GetResource(MAPL,USE_PRECIP_IN_RADIATION,'RRTMGSW_USE_PRECIP_IN_RADIATION:',DEFAULT=.TRUE.,RC=STATUS) - VERIFY_(STATUS) + VERIFY_(STATUS) else call MAPL_GetResource(MAPL,USE_PRECIP_IN_RADIATION,'RRTMGSW_USE_PRECIP_IN_RADIATION:',DEFAULT=.FALSE.,RC=STATUS) VERIFY_(STATUS) @@ -7129,8 +7158,8 @@ subroutine UPDATE_EXPORT(IM,JM,LM, RC) integer :: iseg, ibbeg, ibend, jb, kb, kb_start, kb_used_last logical :: sfirst, ofirst - ! band wavenumber bounds (m-1) - real :: wn1, wn2 + ! band wavenumber bounds (m-1) + real :: wn1, wn2 Iam = trim(COMP_NAME)//"SolarUpdateExport" @@ -7634,7 +7663,7 @@ subroutine UPDATE_EXPORT(IM,JM,LM, RC) where (aCLDT > 0.) aTAUT = (aTAUL*aCLDL + aTAUM*aCLDM + aTAUH*aCLDH) / aCLDT if (associated(TAUX)) TAUX = aTAUT if (associated(COTT)) then - COTT = MAPL_UNDEF + COTT = MAPL_UNDEF where (aCLDT > 0.) COTT = aTAUT end if if (associated(COTNT)) COTNT = aCLDT * aTAUT @@ -7911,7 +7940,7 @@ subroutine UPDATE_EXPORT(IM,JM,LM, RC) else ! USE_RRTMGP ! get RRTMGP wavenumbers - if (.not. have_rrtmgp_wavenums) then + if (.not. have_rrtmgp_wavenums) then ! access RRTMGP internal state from the GC if (.not. rrtmgp_state_set) then @@ -7919,7 +7948,7 @@ subroutine UPDATE_EXPORT(IM,JM,LM, RC) VERIFY_(status) rrtmgp_state => wrap%ptr rrtmgp_state_set = .true. - end if + end if ! helper for testing RRTMGP error status on return; ! allows line number reporting cf. original call method @@ -7928,7 +7957,7 @@ subroutine UPDATE_EXPORT(IM,JM,LM, RC) ! initialize k-distribution if not already done ! remember: its possible to have UPDATE_FIRST if (.not. rrtmgp_state%initialized) then - call MAPL_GetResource( & + call MAPL_GetResource( & MAPL, k_dist_file, "RRTMGP_GAS_SW:", & DEFAULT='rrtmgp-gas-sw-g112.nc',__RC__) ! gas_concs needed only to access required gas names @@ -7976,7 +8005,7 @@ subroutine UPDATE_EXPORT(IM,JM,LM, RC) if (USE_RRTMGP) then ! get RRTMGP wavenumbers - if (.not. have_rrtmgp_wavenums) then + if (.not. have_rrtmgp_wavenums) then ! access RRTMGP internal state from the GC if (.not. rrtmgp_state_set) then @@ -7984,7 +8013,7 @@ subroutine UPDATE_EXPORT(IM,JM,LM, RC) VERIFY_(status) rrtmgp_state => wrap%ptr rrtmgp_state_set = .true. - end if + end if ! helper for testing RRTMGP error status on return; ! allows line number reporting cf. original call method @@ -7993,7 +8022,7 @@ subroutine UPDATE_EXPORT(IM,JM,LM, RC) ! initialize k-distribution if not already done ! remember: its possible to have UPDATE_FIRST if (.not. rrtmgp_state%initialized) then - call MAPL_GetResource( & + call MAPL_GetResource( & MAPL, k_dist_file, "RRTMGP_GAS_SW:", & DEFAULT='rrtmgp-gas-sw-g112.nc',__RC__) ! gas_concs needed only to access required gas names