Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Sync develop into main #1027

Merged
merged 11 commits into from
Nov 5, 2024
18 changes: 10 additions & 8 deletions GEOS_GcmGridComp.F90
Original file line number Diff line number Diff line change
Expand Up @@ -1308,15 +1308,17 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC )
result=GCM_INTERNAL_STATE%SURF_IMP, rc=status)
VERIFY_(STATUS)

!select TURBULENCE export
call MAPL_ExportStateGet(GEX, name='TURBULENCE', &
result=GCM_INTERNAL_STATE%TURB_EXP, rc=status)
VERIFY_(STATUS)
if(.not. DO_DATA_ATM4OCN) then
!select TURBULENCE export
call MAPL_ExportStateGet(GEX, name='TURBULENCE', &
result=GCM_INTERNAL_STATE%TURB_EXP, rc=status)
VERIFY_(STATUS)

!select SURFACE import
call MAPL_ImportStateGet(GC, import=import, name='TURBULENCE', &
result=GCM_INTERNAL_STATE%TURB_IMP, rc=status)
VERIFY_(STATUS)
!select TURBULENCE import
call MAPL_ImportStateGet(GC, import=import, name='TURBULENCE', &
result=GCM_INTERNAL_STATE%TURB_IMP, rc=status)
VERIFY_(STATUS)
endif

!select OCEAN export
call MAPL_ExportStateGet(GEX, name='OCEAN', &
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,7 @@ endif ()
# and 10 minutes at O2. But only 7 seconds with O1. So we compile at O1
if (CMAKE_Fortran_COMPILER_ID MATCHES Intel AND CMAKE_BUILD_TYPE MATCHES Release)
set_source_files_properties(GEOS_BACM_1M_InterfaceMod.F90 PROPERTIES COMPILE_OPTIONS ${FOPT1})
set_source_files_properties(GEOS_MGB2_2M_InterfaceMod.F90 PROPERTIES COMPILE_OPTIONS ${FOPT1})
# set_source_files_properties(GEOS_MGB2_2M_InterfaceMod.F90 PROPERTIES COMPILE_OPTIONS ${FOPT1})
endif ()

esma_add_library (${this}
Expand Down

Large diffs are not rendered by default.

Original file line number Diff line number Diff line change
Expand Up @@ -4778,7 +4778,7 @@ subroutine SetServices ( GC, RC )
VERIFY_(STATUS)

call MAPL_AddExportSpec(GC, &
SHORT_NAME='QCVAR_EXP', &
SHORT_NAME='QCVAR', &
LONG_NAME ='inverse relative variance of cloud water', &
UNITS = '1', &
DIMS = MAPL_DimsHorzOnly, &
Expand Down Expand Up @@ -5222,7 +5222,7 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC )
real, allocatable, dimension(:,:) :: TMP2D
! Internals
real, pointer, dimension(:,:,:) :: Q, QLLS, QLCN, CLLS, CLCN, QILS, QICN
real, pointer, dimension(:,:,:) :: NACTL, NACTI
real, pointer, dimension(:,:,:) :: NACTL, NACTI, NCPL, NCPI
! Imports
real, pointer, dimension(:,:,:) :: ZLE, PLE, T, U, V, W
real, pointer, dimension(:,:) :: FRLAND, FRLANDICE, FRACI, SNOMAS
Expand Down Expand Up @@ -5295,6 +5295,8 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC )
call MAPL_GetPointer(INTERNAL, QICN, 'QICN' , RC=STATUS); VERIFY_(STATUS)
call MAPL_GetPointer(INTERNAL, NACTL, 'NACTL' , RC=STATUS); VERIFY_(STATUS)
call MAPL_GetPointer(INTERNAL, NACTI, 'NACTI' , RC=STATUS); VERIFY_(STATUS)
call MAPL_GetPointer(INTERNAL, NCPL, 'NACTL' , RC=STATUS); VERIFY_(STATUS)
call MAPL_GetPointer(INTERNAL, NCPI, 'NACTI' , RC=STATUS); VERIFY_(STATUS)

! Import State
call MAPL_GetPointer(IMPORT, PLE, 'PLE' , RC=STATUS); VERIFY_(STATUS)
Expand Down Expand Up @@ -5559,7 +5561,7 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC )
end where
endif

if (.FALSE.) then
if (adjustl(CLDMICR_OPTION)=="MGB2_2M") then
QST3 = GEOS_QsatLQU (T, PLmb*100.0, DQ=DQST3) !clean up only with respect to liquid water
else
DQST3 = GEOS_DQSAT (T, PLmb, QSAT=QST3) ! this qsat function expects hPa...
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -1112,18 +1112,21 @@ subroutine fix_up_clouds_2M( &
QG, &
NR, &
NS, &
NG)
NG, &
MASS, &
TMP2D)

real, intent(inout), dimension(:,:,:) :: TE,QV,QLC,CF,QLA,AF,QIC,QIA, QR, QS, QG
real, intent(inout), dimension(:,:,:) :: NI, NL, NS, NR, NG
real, dimension(:,:,:), intent(in) :: MASS
real, dimension(:,:), intent( out) :: TMP2D
integer :: IM, JM, LM

real, parameter :: qmin = 1.0e-12
real, parameter :: cfmin = 1.0e-4
real, parameter :: nmin = 100.0




! Fix if Anvil cloud fraction too small
where (AF < cfmin)
QV = QV + QLA + QIA
Expand Down Expand Up @@ -1184,9 +1187,22 @@ subroutine fix_up_clouds_2M( &
QLC = 0.
QIC = 0.
end where




IM = SIZE( QV, 1 )
JM = SIZE( QV, 2 )
LM = SIZE( QV, 3 )


!make sure QI , NI stay within T limits
call meltfrz_inst2M ( IM, JM, LM, &
TE , &
QLC , &
QLA , &
QIC , &
QIA , &
NL , &
NI )

!make sure no negative number concentrations are passed
!and that N goes to minimum defaults in the microphysics when mass is too small

Expand All @@ -1205,6 +1221,18 @@ subroutine fix_up_clouds_2M( &
where (QS .le. qmin) NS = 0.

where (QG .le. qmin) NG = 0.

! need to clean up small negative values. MG does can't handle them
call FILLQ2ZERO( QV, MASS, TMP2D)
call FILLQ2ZERO( QG, MASS, TMP2D)
call FILLQ2ZERO( QR, MASS, TMP2D)
call FILLQ2ZERO( QS, MASS, TMP2D)
call FILLQ2ZERO( QLC, MASS, TMP2D)
call FILLQ2ZERO( QLA, MASS, TMP2D)
call FILLQ2ZERO( QIC, MASS, TMP2D)
call FILLQ2ZERO( QIA, MASS, TMP2D)
call FILLQ2ZERO( CF, MASS, TMP2D)
call FILLQ2ZERO( AF, MASS, TMP2D)

end subroutine fix_up_clouds_2M

Expand Down Expand Up @@ -2276,17 +2304,17 @@ end subroutine hystpdf

!==========Estimate RHcrit========================
!==============================
subroutine pdf_alpha(PP,P_LM, ALPHA, FRLAND, MINRHCRIT, TURNRHCRIT, EIS, RHC_OPTION)
subroutine pdf_alpha(PP,P_LM, ALPHA, FRLAND, MINRHCRIT, TURNRHCRIT, TURNRHCRIT_UPPER, EIS, RHC_OPTION)

real, intent(in) :: PP, P_LM !mbar
real, intent(out) :: ALPHA
real, intent(in) :: FRLAND
real, intent(in) :: MINRHCRIT, TURNRHCRIT, EIS
real, intent(in) :: MINRHCRIT, TURNRHCRIT, EIS, TURNRHCRIT_UPPER
integer, intent(in) :: RHC_OPTION !0-Slingo(1985), 1-QUAAS (2012)
real :: dw_land = 0.20 !< base value for subgrid deviation / variability over land
real :: dw_ocean = 0.10 !< base value for ocean
real :: sloperhcrit =20.
real :: TURNRHCRIT_UPPER = 300.
!real :: TURNRHCRIT_UPPER = 300.
real :: aux1, aux2, maxalpha

IF (RHC_OPTION .lt. 1) then
Expand All @@ -2304,9 +2332,13 @@ subroutine pdf_alpha(PP,P_LM, ALPHA, FRLAND, MINRHCRIT, TURNRHCRIT, EIS, RHC_OPT
aux1 = 1.0/(1.0+exp(aux1)) !this function reproduces the old Sligo function.
end if

!aux2= 1.0/(1.0+exp(aux2)) !this function would reverse the profile P< TURNRHCRIT_UPPER
aux2=1.0
ALPHA = min(maxalpha*aux1*aux2, 0.3)
if (TURNRHCRIT_UPPER .gt. 0.0) then
aux2= 1.0/(1.0+exp(aux2)) !this function reverses the profile P< TURNRHCRIT_UPPER
else
aux2=1.0
end if

ALPHA = min(maxalpha*aux1*aux2, 0.4)

ELSE
! based on Quass 2012 https://doi.org/10.1029/2012JD017495
Expand Down Expand Up @@ -3313,9 +3345,12 @@ subroutine update_cld( &
QSLIQ = GEOS_QsatLQU( TE, PL*100.0 , DQ=DQx )
QSICE = GEOS_QsatICE( TE, PL*100.0 , DQ=DQX )

if ((QC+QA) .gt. 1.0e-13) then
QSx=((QCl+QAl)*QSLIQ + QSICE*(QCi+QAi))/(QC+QA)
else

IF (QCl + QAl .gt. 0.) then
QSx = QSLIQ
ELSEIF (QCi + QAi.gt. 0.) then
QSx = QSICE
ELSE
DQSx = GEOS_DQSAT( TE, PL, QSAT=QSx )
end if

Expand Down Expand Up @@ -3352,8 +3387,10 @@ subroutine update_cld( &
if (QSx .gt. tiny(1.0)) then
RHCmicro = SCICE - 0.5*DELQ/Qsx
else
RHCmicro = 0.0
RHCmicro = 1.0-ALPHA
end if

RHCmicro = max(min(RHCmicro, 0.99), 0.6)

CFALL = max(CFo, 0.0)
CFALL = min(CFo, 1.0)
Expand All @@ -3367,8 +3404,7 @@ end subroutine update_cld



subroutine meltfrz_inst2M ( &
IM,JM,LM , &
subroutine meltfrz_inst2M ( IM, JM, LM, &
TE , &
QCL , &
QAL , &
Expand All @@ -3377,8 +3413,8 @@ subroutine meltfrz_inst2M ( &
NL , &
NI )

integer, intent(in) :: IM,JM,LM
real , intent(inout), dimension(:,:,:) :: TE,QCL,QCI, QAL, QAI, NI, NL
integer, intent(in) :: IM, JM, LM

real , dimension(im,jm,lm) :: dQil, DQmax, QLTOT, QITOT, dNil, FQA
real :: T_ICE_ALL = 240.
Expand All @@ -3388,8 +3424,7 @@ subroutine meltfrz_inst2M ( &
QLTOT=QCL + QAL
FQA = 0.0


where (QITOT+QLTOT .gt. 0.0)
where (QITOT+QLTOT .gt. tiny(0.0))
FQA= (QAI+QAL)/(QITOT+QLTOT)
end where

Expand All @@ -3408,7 +3443,7 @@ subroutine meltfrz_inst2M ( &
dNil = NL
end where

where ((dQil .gt. DQmax) .and. (dQil .gt. 0.0))
where ((dQil .gt. DQmax) .and. (dQil .gt. tiny(0.0)))
dNil = NL*DQmax/dQil
end where

Expand All @@ -3432,7 +3467,7 @@ subroutine meltfrz_inst2M ( &
where ((dQil .le. DQmax) .and. (dQil .gt. 0.0))
dNil = NI
end where
where ((dQil .gt. DQmax) .and. (dQil .gt. 0.0))
where ((dQil .gt. DQmax) .and. (dQil .gt. tiny(0.0)))
dNil = NI*DQmax/dQil
end where
dQil = max( 0., dQil )
Expand Down
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Collections:
WSUB_SWclim_2005%m2.nc4:
template: /discover/nobackup/dbarahon/DEV/SWclim/L72/SWclim_2005%m2.nc4
valid_range: "2005-01-01/2005-12-31"
valid_range: "2005-01-01/2005-12-01"

Samplings:
WSUB_sample_0:
Expand Down
Loading
Loading