From ddfcec2ce4b84bb058802cf34c514e86afc1adf5 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Wed, 10 May 2023 11:49:00 -0600 Subject: [PATCH 01/41] Switching io_int/intio tags to #defines --- external/io_int/io_int.F90 | 116 ++++++++++++++++++----------------- external/io_int/io_int_idx.c | 2 +- inc/intio_tags.h | 68 ++++++++++---------- 3 files changed, 94 insertions(+), 92 deletions(-) diff --git a/external/io_int/io_int.F90 b/external/io_int/io_int.F90 index e57224b51e..ab95b49a45 100644 --- a/external/io_int/io_int.F90 +++ b/external/io_int/io_int.F90 @@ -9,6 +9,8 @@ ! Uses header manipulation routines in module_io_quilt.F ! +#include "intio_tags.h" + MODULE module_ext_internal USE module_internal_header_util @@ -168,7 +170,7 @@ SUBROUTINE ext_int_open_for_write( FileName , Comm_compute, Comm_io, SysDepInfo, DataHandle , Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + CHARACTER*(*) :: FileName INTEGER , INTENT(IN) :: Comm_compute , Comm_io CHARACTER*(*) :: SysDepInfo @@ -187,7 +189,7 @@ SUBROUTINE ext_int_open_for_write_begin( FileName , Comm_compute, Comm_io, SysDe DataHandle , Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + #include "wrf_io_flags.h" CHARACTER*(*) :: FileName INTEGER , INTENT(IN) :: Comm_compute , Comm_io @@ -221,7 +223,7 @@ END SUBROUTINE ext_int_open_for_write_begin SUBROUTINE ext_int_open_for_write_commit( DataHandle , Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + #include "wrf_io_flags.h" INTEGER , INTENT(IN ) :: DataHandle INTEGER , INTENT(OUT) :: Status @@ -362,7 +364,7 @@ SUBROUTINE ext_int_ioexit( Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + INTEGER , INTENT(OUT) :: Status INTEGER :: DataHandle INTEGER i,ierr @@ -375,7 +377,7 @@ END SUBROUTINE ext_int_ioexit SUBROUTINE ext_int_get_next_time ( DataHandle, DateStr, Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*) :: DateStr INTEGER , INTENT(OUT) :: Status @@ -417,7 +419,7 @@ SUBROUTINE ext_int_get_next_time ( DataHandle, DateStr, Status ) READ( unit=DataHandle, iostat=istat ) hdrbuf ! this is okay as long as no other record type has data that follows IF ( istat .EQ. 0 ) THEN code = hdrbuf(2) - IF ( code .EQ. int_field ) THEN + IF ( code .EQ. INT_FIELD ) THEN CALL int_get_write_field_header ( hdrbuf, hdrbufsize, inttypesize, typesize, & locDataHandle , locDateStr , locVarName , Field , locFieldType , locComm , locIOComm, & locDomainDesc , locMemoryOrder , locStagger , locDimNames , & @@ -433,7 +435,7 @@ SUBROUTINE ext_int_get_next_time ( DataHandle, DateStr, Status ) ELSE READ( unit=DataHandle, iostat=istat ) ENDIF - ELSE IF ( code .EQ. int_dom_td_char ) THEN + ELSE IF ( code .EQ. INT_DOM_TD_CHAR ) THEN CALL int_get_td_header_char( hdrbuf, hdrbufsize, itypesize, & locDataHandle, locDateStr, locElement, locData, loccode ) IF ( TRIM(locDateStr) .NE. TRIM(CurrentDateInFile(DataHandle) ) ) THEN ! control break, return this date @@ -460,13 +462,13 @@ END SUBROUTINE ext_int_get_next_time SUBROUTINE ext_int_set_time ( DataHandle, DateStr, Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*) :: DateStr INTEGER , INTENT(OUT) :: Status CALL int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, & - DataHandle, "TIMESTAMP", "", TRIM(DateStr), int_set_time ) + DataHandle, "TIMESTAMP", "", TRIM(DateStr), INT_SET_TIME ) WRITE( unit=DataHandle ) hdrbuf Status = 0 RETURN @@ -477,7 +479,7 @@ SUBROUTINE ext_int_get_var_info ( DataHandle , VarName , NDim , MemoryOrder , St DomainStart , DomainEnd , WrfType, Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: VarName integer ,intent(out) :: NDim @@ -519,7 +521,7 @@ SUBROUTINE ext_int_get_var_info ( DataHandle , VarName , NDim , MemoryOrder , St READ( unit=DataHandle, iostat=istat ) hdrbuf ! this is okay as long as no other record type has data that follows IF ( istat .EQ. 0 ) THEN code = hdrbuf(2) - IF ( code .EQ. int_field ) THEN + IF ( code .EQ. INT_FIELD ) THEN CALL int_get_write_field_header ( hdrbuf, hdrbufsize, inttypesize, typesize, & locDataHandle , locDateStr , locVarName , Field , locFieldType , locComm , locIOComm, & locDomainDesc , MemoryOrder , locStagger , locDimNames , & @@ -561,7 +563,7 @@ END SUBROUTINE ext_int_get_var_info SUBROUTINE ext_int_get_next_var ( DataHandle, VarName, Status ) USE module_ext_internal IMPLICIT NONE - include 'intio_tags.h' + include 'wrf_status_codes.h' INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*) :: VarName @@ -606,20 +608,20 @@ SUBROUTINE ext_int_get_next_var ( DataHandle, VarName, Status ) IF ( istat .EQ. 0 ) THEN code = hdrbuf(2) #if 1 - IF ( code .EQ. int_dom_ti_char ) THEN + IF ( code .EQ. INT_DOM_TI_CHAR ) THEN CALL int_get_ti_header_char( hdrbuf, hdrbufsize, itypesize, & locDataHandle, locElement, dumstr, strData, loccode ) ENDIF - IF ( code .EQ. int_dom_ti_integer ) THEN + IF ( code .EQ. INT_DOM_TI_INTEGER ) THEN CALL int_get_ti_header( hdrbuf, hdrbufsize, itypesize, rtypesize, & locDataHandle, locElement, iData, loccount, code ) ENDIF - IF ( code .EQ. int_dom_ti_real ) THEN + IF ( code .EQ. INT_DOM_TI_REAL ) THEN CALL int_get_ti_header( hdrbuf, hdrbufsize, itypesize, rtypesize, & locDataHandle, locElement, rData, loccount, code ) ENDIF #endif - IF ( code .EQ. int_field ) THEN + IF ( code .EQ. INT_FIELD ) THEN CALL int_get_write_field_header ( hdrbuf, hdrbufsize, inttypesize, typesize, & locDataHandle , locDateStr , locVarName , Field , locFieldType , locComm , locIOComm, & locDomainDesc , locMemoryOrder , locStagger , locDimNames , & @@ -660,7 +662,7 @@ END SUBROUTINE ext_int_get_next_var SUBROUTINE ext_int_get_dom_ti_real ( DataHandle,Element, Data, Count, Outcount, Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*) :: Element REAL , INTENT(OUT) :: Data(*) @@ -681,7 +683,7 @@ SUBROUTINE ext_int_get_dom_ti_real ( DataHandle,Element, Data, Count, Outcount READ( unit=DataHandle , iostat = istat ) hdrbuf IF ( istat .EQ. 0 ) THEN code = hdrbuf(2) - IF ( code .EQ. int_dom_ti_real ) THEN + IF ( code .EQ. INT_DOM_TI_REAL ) THEN CALL int_get_ti_header( hdrbuf, hdrbufsize, itypesize, rtypesize, & locDataHandle, locElement, Data, loccount, code ) IF ( TRIM(locElement) .EQ. TRIM(Element) ) THEN @@ -690,11 +692,11 @@ SUBROUTINE ext_int_get_dom_ti_real ( DataHandle,Element, Data, Count, Outcount ENDIF keepgoing = .false. ; Status = 0 ENDIF - ELSE IF ( .NOT. ( code .EQ. int_dom_ti_integer .OR. code .EQ. int_dom_ti_logical .OR. & - code .EQ. int_dom_ti_char .OR. code .EQ. int_dom_ti_double .OR. & - code .EQ. int_dom_td_integer .OR. code .EQ. int_dom_td_logical .OR. & - code .EQ. int_dom_td_char .OR. code .EQ. int_dom_td_double .OR. & - code .EQ. int_dom_td_real ) ) THEN + ELSE IF ( .NOT. ( code .EQ. INT_DOM_TI_INTEGER .OR. code .EQ. INT_DOM_TI_LOGICAL .OR. & + code .EQ. INT_DOM_TI_CHAR .OR. code .EQ. INT_DOM_TI_DOUBLE .OR. & + code .EQ. INT_DOM_TD_INTEGER .OR. code .EQ. INT_DOM_TD_LOGICAL .OR. & + code .EQ. INT_DOM_TD_CHAR .OR. code .EQ. INT_DOM_TD_DOUBLE .OR. & + code .EQ. INT_DOM_TD_REAL ) ) THEN BACKSPACE ( unit=DataHandle ) keepgoing = .false. ; Status = 2 ENDIF @@ -712,7 +714,7 @@ END SUBROUTINE ext_int_get_dom_ti_real SUBROUTINE ext_int_put_dom_ti_real ( DataHandle,Element, Data, Count, Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*) :: Element REAL , INTENT(IN) :: Data(*) @@ -726,7 +728,7 @@ SUBROUTINE ext_int_put_dom_ti_real ( DataHandle,Element, Data, Count, Status ! Do nothing unless it is time to write time-independent domain metadata. IF ( int_ok_to_put_dom_ti( DataHandle ) ) THEN CALL int_gen_ti_header( hdrbuf, hdrbufsize, itypesize, rtypesize, & - DataHandle, Element, Data, Count, int_dom_ti_real ) + DataHandle, Element, Data, Count, INT_DOM_TI_REAL ) WRITE( unit=DataHandle ) hdrbuf ENDIF ENDIF @@ -772,7 +774,7 @@ END SUBROUTINE ext_int_put_dom_ti_double SUBROUTINE ext_int_get_dom_ti_integer ( DataHandle,Element, Data, Count, Outcount, Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*) :: Element integer , INTENT(OUT) :: Data(*) @@ -793,7 +795,7 @@ SUBROUTINE ext_int_get_dom_ti_integer ( DataHandle,Element, Data, Count, Outco READ( unit=DataHandle , iostat = istat ) hdrbuf IF ( istat .EQ. 0 ) THEN code = hdrbuf(2) - IF ( code .EQ. int_dom_ti_integer ) THEN + IF ( code .EQ. INT_DOM_TI_INTEGER ) THEN CALL int_get_ti_header( hdrbuf, hdrbufsize, itypesize, rtypesize, & locDataHandle, locElement, Data, loccount, code ) IF ( TRIM(locElement) .EQ. TRIM(Element) ) THEN @@ -803,11 +805,11 @@ SUBROUTINE ext_int_get_dom_ti_integer ( DataHandle,Element, Data, Count, Outco keepgoing = .false. ; Status = 0 ENDIF - ELSE IF ( .NOT. ( code .EQ. int_dom_ti_real .OR. code .EQ. int_dom_ti_logical .OR. & - code .EQ. int_dom_ti_char .OR. code .EQ. int_dom_ti_double .OR. & - code .EQ. int_dom_td_real .OR. code .EQ. int_dom_td_logical .OR. & - code .EQ. int_dom_td_char .OR. code .EQ. int_dom_td_double .OR. & - code .EQ. int_dom_td_integer ) ) THEN + ELSE IF ( .NOT. ( code .EQ. INT_DOM_TI_REAL .OR. code .EQ. INT_DOM_TI_LOGICAL .OR. & + code .EQ. INT_DOM_TI_CHAR .OR. code .EQ. INT_DOM_TI_DOUBLE .OR. & + code .EQ. INT_DOM_TD_REAL .OR. code .EQ. INT_DOM_TD_LOGICAL .OR. & + code .EQ. INT_DOM_TD_CHAR .OR. code .EQ. INT_DOM_TD_DOUBLE .OR. & + code .EQ. INT_DOM_TD_INTEGER ) ) THEN BACKSPACE ( unit=DataHandle ) keepgoing = .false. ; Status = 1 ENDIF @@ -825,7 +827,7 @@ END SUBROUTINE ext_int_get_dom_ti_integer SUBROUTINE ext_int_put_dom_ti_integer ( DataHandle,Element, Data, Count, Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*) :: Element INTEGER , INTENT(IN) :: Data(*) @@ -838,7 +840,7 @@ SUBROUTINE ext_int_put_dom_ti_integer ( DataHandle,Element, Data, Count, Stat ! Do nothing unless it is time to write time-independent domain metadata. IF ( int_ok_to_put_dom_ti( DataHandle ) ) THEN CALL int_gen_ti_header( hdrbuf, hdrbufsize, itypesize, itypesize, & - DataHandle, Element, Data, Count, int_dom_ti_integer ) + DataHandle, Element, Data, Count, INT_DOM_TI_INTEGER ) WRITE( unit=DataHandle ) hdrbuf ENDIF ENDIF @@ -884,7 +886,7 @@ END SUBROUTINE ext_int_put_dom_ti_logical SUBROUTINE ext_int_get_dom_ti_char ( DataHandle,Element, Data, Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*) :: Element CHARACTER*(*) :: Data @@ -905,17 +907,17 @@ SUBROUTINE ext_int_get_dom_ti_char ( DataHandle,Element, Data, Status ) IF ( istat .EQ. 0 ) THEN code = hdrbuf(2) - IF ( code .EQ. int_dom_ti_char ) THEN + IF ( code .EQ. INT_DOM_TI_CHAR ) THEN CALL int_get_ti_header_char( hdrbuf, hdrbufsize, itypesize, & locDataHandle, locElement, dumstr, Data, code ) IF ( TRIM(locElement) .EQ. TRIM(Element) ) THEN keepgoing = .false. ; Status = 0 ENDIF - ELSE IF ( .NOT. ( code .EQ. int_dom_ti_real .OR. code .EQ. int_dom_ti_logical .OR. & - code .EQ. int_dom_ti_integer .OR. code .EQ. int_dom_ti_double .OR. & - code .EQ. int_dom_td_real .OR. code .EQ. int_dom_td_logical .OR. & - code .EQ. int_dom_td_integer .OR. code .EQ. int_dom_td_double .OR. & - code .EQ. int_dom_td_char ) ) THEN + ELSE IF ( .NOT. ( code .EQ. INT_DOM_TI_REAL .OR. code .EQ. INT_DOM_TI_LOGICAL .OR. & + code .EQ. INT_DOM_TI_INTEGER .OR. code .EQ. INT_DOM_TI_DOUBLE .OR. & + code .EQ. INT_DOM_TD_REAL .OR. code .EQ. INT_DOM_TD_LOGICAL .OR. & + code .EQ. INT_DOM_TD_INTEGER .OR. code .EQ. INT_DOM_TD_DOUBLE .OR. & + code .EQ. INT_DOM_TD_CHAR ) ) THEN BACKSPACE ( unit=DataHandle ) keepgoing = .false. ; Status = 1 ENDIF @@ -933,7 +935,7 @@ END SUBROUTINE ext_int_get_dom_ti_char SUBROUTINE ext_int_put_dom_ti_char ( DataHandle, Element, Data, Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*) :: Element CHARACTER*(*) :: Data @@ -947,7 +949,7 @@ SUBROUTINE ext_int_put_dom_ti_char ( DataHandle, Element, Data, Status ) ! Do nothing unless it is time to write time-independent domain metadata. IF ( int_ok_to_put_dom_ti( DataHandle ) ) THEN CALL int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, & - DataHandle, Element, "", Data, int_dom_ti_char ) + DataHandle, Element, "", Data, INT_DOM_TI_CHAR ) WRITE( unit=DataHandle ) hdrbuf ENDIF ENDIF @@ -1062,7 +1064,7 @@ END SUBROUTINE ext_int_put_dom_td_logical SUBROUTINE ext_int_get_dom_td_char ( DataHandle,Element, DateStr, Data, Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*) :: Element CHARACTER*(*) :: Data, DateStr @@ -1080,7 +1082,7 @@ SUBROUTINE ext_int_get_dom_td_char ( DataHandle,Element, DateStr, Data, Status IF ( istat .EQ. 0 ) THEN code = hdrbuf(2) - IF ( code .EQ. int_dom_td_char ) THEN + IF ( code .EQ. INT_DOM_TD_CHAR ) THEN CALL int_get_td_header_char( hdrbuf, hdrbufsize, itypesize, & locDataHandle, locDateStr, locElement, Data, code ) IF ( TRIM(locElement) .EQ. TRIM(Element) ) THEN @@ -1103,7 +1105,7 @@ END SUBROUTINE ext_int_get_dom_td_char SUBROUTINE ext_int_put_dom_td_char ( DataHandle,Element, DateStr, Data, Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*) :: Element CHARACTER*(*) :: Data, DateStr @@ -1114,7 +1116,7 @@ SUBROUTINE ext_int_put_dom_td_char ( DataHandle,Element, DateStr, Data, Status IF ( int_valid_handle ( Datahandle ) ) THEN IF ( int_handle_in_use( DataHandle ) ) THEN CALL int_gen_td_header_char( hdrbuf, hdrbufsize, itypesize, & - DataHandle, DateStr, Element, Data, int_dom_td_char ) + DataHandle, DateStr, Element, Data, INT_DOM_TD_CHAR ) WRITE( unit=DataHandle ) hdrbuf ENDIF ENDIF @@ -1178,7 +1180,7 @@ END SUBROUTINE ext_int_put_var_ti_double SUBROUTINE ext_int_get_var_ti_integer ( DataHandle,Element, Varname, Data, Count, Outcount, Status ) USE module_ext_internal IMPLICIT NONE -#include "intio_tags.h" + INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*) :: Element CHARACTER*(*) :: VarName @@ -1192,7 +1194,7 @@ SUBROUTINE ext_int_get_var_ti_integer ( DataHandle,Element, Varname, Data, Coun IF ( int_handle_in_use( DataHandle ) ) THEN READ( unit=DataHandle ) hdrbuf code=hdrbuf(2) - IF ( code .NE. int_var_ti_integer ) THEN + IF ( code .NE. INT_VAR_TI_INTEGER ) THEN BACKSPACE ( unit=DataHandle ) write(*,*) 'unexpected code=',code,' in ext_int_get_var_ti_integer' Status = 1 @@ -1219,7 +1221,7 @@ SUBROUTINE ext_int_put_var_ti_integer ( DataHandle,Element, Varname, Data, Coun USE module_ext_internal USE module_internal_header_util, only: int_gen_ti_header_integer_varna IMPLICIT NONE -#include "intio_tags.h" + INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*) :: Element CHARACTER*(*) :: VarName @@ -1230,7 +1232,7 @@ SUBROUTINE ext_int_put_var_ti_integer ( DataHandle,Element, Varname, Data, Coun IF ( int_handle_in_use( DataHandle ) ) THEN CALL int_gen_ti_header_integer_varna( hdrbuf, hdrbufsize, itypesize,4, & DataHandle, TRIM(Element), TRIM(VarName), Data, Count, & - int_var_ti_integer ) + INT_VAR_TI_INTEGER ) WRITE( unit=DataHandle ) hdrbuf ENDIF ENDIF @@ -1267,7 +1269,7 @@ END SUBROUTINE ext_int_put_var_ti_logical SUBROUTINE ext_int_get_var_ti_char ( DataHandle,Element, Varname, Data, Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*) :: Element CHARACTER*(*) :: VarName @@ -1279,7 +1281,7 @@ SUBROUTINE ext_int_get_var_ti_char ( DataHandle,Element, Varname, Data, Status IF ( int_handle_in_use( DataHandle ) ) THEN READ( unit=DataHandle ) hdrbuf code=hdrbuf(2) - IF ( code .NE. int_var_ti_char ) THEN + IF ( code .NE. INT_VAR_TI_CHAR ) THEN BACKSPACE ( unit=DataHandle ) Status = 1 return @@ -1302,7 +1304,7 @@ END SUBROUTINE ext_int_get_var_ti_char SUBROUTINE ext_int_put_var_ti_char ( DataHandle,Element, Varname, Data, Status ) USE module_ext_internal IMPLICIT NONE - INCLUDE 'intio_tags.h' + INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*) :: Element CHARACTER*(*) :: VarName @@ -1313,7 +1315,7 @@ SUBROUTINE ext_int_put_var_ti_char ( DataHandle,Element, Varname, Data, Status IF ( int_valid_handle (DataHandle) ) THEN IF ( int_handle_in_use( DataHandle ) ) THEN CALL int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, & - DataHandle, TRIM(Element), TRIM(VarName), TRIM(Data), int_var_ti_char ) + DataHandle, TRIM(Element), TRIM(VarName), TRIM(Data), INT_VAR_TI_CHAR ) WRITE( unit=DataHandle ) hdrbuf ENDIF ENDIF @@ -1465,7 +1467,7 @@ SUBROUTINE ext_int_read_field ( DataHandle , DateStr , VarName , Field , FieldTy USE module_ext_internal IMPLICIT NONE #include "wrf_io_flags.h" - include 'intio_tags.h' + INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*) :: DateStr CHARACTER*(*) :: VarName @@ -1519,7 +1521,7 @@ SUBROUTINE ext_int_read_field ( DataHandle , DateStr , VarName , Field , FieldTy READ( unit=DataHandle, iostat=istat ) hdrbuf ! this is okay as long as no other record type has data that follows IF ( istat .EQ. 0 ) THEN code = hdrbuf(2) - IF ( code .EQ. int_field ) THEN + IF ( code .EQ. INT_FIELD ) THEN CALL int_get_write_field_header ( hdrbuf, hdrbufsize, inttypesize, typesize, & locDataHandle , locDateStr , locVarName , Field , locFieldType , locComm , locIOComm, & locDomainDesc , locMemoryOrder , locStagger , locDimNames , & diff --git a/external/io_int/io_int_idx.c b/external/io_int/io_int_idx.c index 8f812dd356..772263359e 100644 --- a/external/io_int/io_int_idx.c +++ b/external/io_int/io_int_idx.c @@ -19,7 +19,7 @@ #include #include "io_int_idx.h" -#include "io_int_idx_tags.h" +#include "intio_tags.h" /* Static/Private functions within this file */ diff --git a/inc/intio_tags.h b/inc/intio_tags.h index 3808968cf5..daa130ef5f 100644 --- a/inc/intio_tags.h +++ b/inc/intio_tags.h @@ -1,34 +1,34 @@ - INTEGER, PARAMETER :: int_ioexit = 10 - INTEGER, PARAMETER :: int_open_for_write_begin = 20 - INTEGER, PARAMETER :: int_open_for_write_commit = 30 - INTEGER, PARAMETER :: int_open_for_read = 40 - INTEGER, PARAMETER :: int_inquire_opened = 60 - INTEGER, PARAMETER :: int_inquire_filename = 70 - INTEGER, PARAMETER :: int_iosync = 80 - INTEGER, PARAMETER :: int_ioclose = 90 - INTEGER, PARAMETER :: int_next_time = 100 - INTEGER, PARAMETER :: int_set_time = 110 - INTEGER, PARAMETER :: int_next_var = 120 - INTEGER, PARAMETER :: int_dom_ti_real = 140 - INTEGER, PARAMETER :: int_dom_ti_double = 160 - INTEGER, PARAMETER :: int_dom_ti_integer = 180 - INTEGER, PARAMETER :: int_dom_ti_logical = 200 - INTEGER, PARAMETER :: int_dom_ti_char = 220 - INTEGER, PARAMETER :: int_dom_td_real = 240 - INTEGER, PARAMETER :: int_dom_td_double = 260 - INTEGER, PARAMETER :: int_dom_td_integer = 280 - INTEGER, PARAMETER :: int_dom_td_logical = 300 - INTEGER, PARAMETER :: int_dom_td_char = 320 - INTEGER, PARAMETER :: int_var_ti_real = 340 - INTEGER, PARAMETER :: int_var_ti_double = 360 - INTEGER, PARAMETER :: int_var_ti_integer = 380 - INTEGER, PARAMETER :: int_var_ti_logical = 400 - INTEGER, PARAMETER :: int_var_ti_char = 420 - INTEGER, PARAMETER :: int_var_td_real = 440 - INTEGER, PARAMETER :: int_var_td_double = 460 - INTEGER, PARAMETER :: int_var_td_integer = 480 - INTEGER, PARAMETER :: int_var_td_logical = 500 - INTEGER, PARAMETER :: int_var_td_char = 520 - INTEGER, PARAMETER :: int_field = 530 - INTEGER, PARAMETER :: int_var_info = 540 - INTEGER, PARAMETER :: int_noop = 550 +#define INT_IOEXIT 10 +#define INT_OPEN_FOR_WRITE_BEGIN 20 +#define INT_OPEN_FOR_WRITE_COMMIT 30 +#define INT_OPEN_FOR_READ 40 +#define INT_INQUIRE_OPENED 60 +#define INT_INQUIRE_FILENAME 70 +#define INT_IOSYNC 80 +#define INT_IOCLOSE 90 +#define INT_NEXT_TIME 100 +#define INT_SET_TIME 110 +#define INT_NEXT_VAR 120 +#define INT_DOM_TI_REAL 140 +#define INT_DOM_TI_DOUBLE 160 +#define INT_DOM_TI_INTEGER 180 +#define INT_DOM_TI_LOGICAL 200 +#define INT_DOM_TI_CHAR 220 +#define INT_DOM_TD_REAL 240 +#define INT_DOM_TD_DOUBLE 260 +#define INT_DOM_TD_INTEGER 280 +#define INT_DOM_TD_LOGICAL 300 +#define INT_DOM_TD_CHAR 320 +#define INT_VAR_TI_REAL 340 +#define INT_VAR_TI_DOUBLE 360 +#define INT_VAR_TI_INTEGER 380 +#define INT_VAR_TI_LOGICAL 400 +#define INT_VAR_TI_CHAR 420 +#define INT_VAR_TD_REAL 440 +#define INT_VAR_TD_DOUBLE 460 +#define INT_VAR_TD_INTEGER 480 +#define INT_VAR_TD_LOGICAL 500 +#define INT_VAR_TD_CHAR 520 +#define INT_FIELD 530 +#define INT_VAR_INFO 540 +#define INT_NOOP 550 From c14d72b527595edaeba230750f5927b7fa93097b Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Wed, 10 May 2023 11:50:50 -0600 Subject: [PATCH 02/41] Adjusting for new ioint tags --- frame/module_internal_header_util.F | 42 +++---- frame/module_io_quilt_old.F | 182 ++++++++++++++-------------- 2 files changed, 112 insertions(+), 112 deletions(-) diff --git a/frame/module_internal_header_util.F b/frame/module_internal_header_util.F index bfff25916a..35ad9d92b6 100644 --- a/frame/module_internal_header_util.F +++ b/frame/module_internal_header_util.F @@ -110,7 +110,7 @@ SUBROUTINE int_gen_write_field_header ( hdrbuf, hdrbufsize, itypesize, ftypesize ! hdrbufsize: Size of this data header in bytes. ! headerTag: "Header tag" that tells the I/O quilt servers what kind of ! header this is. For a "write field" header it must be set to -! int_field. See file intio_tags.h for a complete list of +! INT_FIELD. See file intio_tags.h for a complete list of ! these tags. ! ftypesize: Size of field data type in bytes. ! DataHandle: Descriptor for an open data set. @@ -145,7 +145,7 @@ SUBROUTINE int_gen_write_field_header ( hdrbuf, hdrbufsize, itypesize, ftypesize hdrbuf(1) = 0 ! deferred -- this will be length of header - hdrbuf(2) = int_field + hdrbuf(2) = INT_FIELD hdrbuf(3) = ftypesize i = 4 @@ -215,8 +215,8 @@ SUBROUTINE int_get_write_field_header ( hdrbuf, hdrbufsize, itypesize, ftypesize INTEGER i, n hdrbufsize = hdrbuf(1) - IF ( hdrbuf(2) .NE. int_field ) THEN - write(mess,*)'int_get_write_field_header: hdrbuf(2) ne int_field ',hdrbuf(2),int_field + IF ( hdrbuf(2) .NE. INT_FIELD ) THEN + write(mess,*)'int_get_write_field_header: hdrbuf(2) ne INT_FIELD ',hdrbuf(2),INT_FIELD CALL wrf_error_fatal ( mess ) ENDIF ftypesize = hdrbuf(3) @@ -269,7 +269,7 @@ SUBROUTINE int_gen_ofr_header( hdrbuf, hdrbufsize, itypesize, & ! hdrbufsize: Size of this data header in bytes. ! headerTag: "Header tag" that tells the I/O quilt servers what kind of ! header this is. For an "open for read" header it must be set to -! int_open_for_read. See file intio_tags.h for a complete list of +! INT_OPEN_FOR_READ. See file intio_tags.h for a complete list of ! these tags. ! DataHandle: Descriptor for an open data set. ! FileName: File name. @@ -292,7 +292,7 @@ SUBROUTINE int_gen_ofr_header( hdrbuf, hdrbufsize, itypesize, & INTEGER i, n, i1 ! hdrbuf(1) = 0 !deferred - hdrbuf(2) = int_open_for_read + hdrbuf(2) = INT_OPEN_FOR_READ i = 3 hdrbuf(i) = DataHandle ; i = i+1 @@ -324,8 +324,8 @@ SUBROUTINE int_get_ofr_header( hdrbuf, hdrbufsize, itypesize, & INTEGER i, n ! hdrbufsize = hdrbuf(1) -! IF ( hdrbuf(2) .NE. int_open_for_read ) THEN -! CALL wrf_error_fatal ( "int_get_ofr_header: hdrbuf ne int_open_for_read") +! IF ( hdrbuf(2) .NE. INT_OPEN_FOR_READ ) THEN +! CALL wrf_error_fatal ( "int_get_ofr_header: hdrbuf ne INT_OPEN_FOR_READ") ! ENDIF i = 3 DataHandle = hdrbuf(i) ; i = i+1 @@ -356,7 +356,7 @@ SUBROUTINE int_gen_ofwb_header( hdrbuf, hdrbufsize, itypesize, & ! hdrbufsize: Size of this data header in bytes. ! headerTag: "Header tag" that tells the I/O quilt servers what kind of ! header this is. For an "open for write begin" header it must be set to -! int_open_for_write_begin. See file intio_tags.h for a complete list of +! INT_OPEN_FOR_WRITE_BEGIN. See file intio_tags.h for a complete list of ! these tags. ! DataHandle: Descriptor for an open data set. ! io_form: I/O format for this file (netCDF, etc.). @@ -381,7 +381,7 @@ SUBROUTINE int_gen_ofwb_header( hdrbuf, hdrbufsize, itypesize, & INTEGER i, n, j ! hdrbuf(1) = 0 !deferred - hdrbuf(2) = int_open_for_write_begin + hdrbuf(2) = INT_OPEN_FOR_WRITE_BEGIN i = 3 hdrbuf(i) = DataHandle ; i = i+1 hdrbuf(i) = io_form ; i = i+1 @@ -420,8 +420,8 @@ SUBROUTINE int_get_ofwb_header( hdrbuf, hdrbufsize, itypesize, & ! hdrbufsize = hdrbuf(1) !write(0,*)' int_get_ofwb_header next rec start ',hdrbuf(hdrbufsize+1) -! IF ( hdrbuf(2) .NE. int_open_for_write_begin ) THEN -! CALL wrf_error_fatal ( "int_get_ofwb_header: hdrbuf ne int_open_for_write_begin") +! IF ( hdrbuf(2) .NE. INT_OPEN_FOR_WRITE_BEGIN ) THEN +! CALL wrf_error_fatal ( "int_get_ofwb_header: hdrbuf ne INT_OPEN_FOR_WRITE_BEGIN") ! ENDIF i = 3 DataHandle = hdrbuf(i) ; i = i+1 @@ -529,7 +529,7 @@ SUBROUTINE int_gen_ti_header_integer( hdrbuf, hdrbufsize, itypesize, typesize, & ! hdrbufsize: Size of this data header in bytes. ! headerTag: "Header tag" that tells the I/O quilt servers what kind of ! header this is. For an "time-independent integer" header it must be -! set to int_dom_ti_integer. See file intio_tags.h for a complete +! set to INT_DOM_TI_INTEGER. See file intio_tags.h for a complete ! list of these tags. ! DataHandle: Descriptor for an open data set. ! typesize: Size in bytes of each element of Data. @@ -584,7 +584,7 @@ SUBROUTINE int_gen_ti_header_integer_varna( hdrbuf, hdrbufsize, itypesize, types ! hdrbufsize: Size of this data header in bytes. ! headerTag: "Header tag" that tells the I/O quilt servers what kind of ! header this is. For an "time-independent integer" header it must be -! set to int_dom_ti_integer. See file intio_tags.h for a complete +! set to INT_DOM_TI_INTEGER. See file intio_tags.h for a complete ! list of these tags. ! DataHandle: Descriptor for an open data set. ! typesize: Size in bytes of each element of Data. @@ -761,7 +761,7 @@ SUBROUTINE int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, & ! hdrbufsize: Size of this data header in bytes. ! headerTag: "Header tag" that tells the I/O quilt servers what kind of ! header this is. For an "time-independent string" header it must be -! set to int_dom_ti_char. See file intio_tags.h for a complete +! set to INT_DOM_TI_CHAR. See file intio_tags.h for a complete ! list of these tags. ! DataHandle: Descriptor for an open data set. ! typesize: 1 (size in bytes of a single CHARACTER). @@ -852,7 +852,7 @@ SUBROUTINE int_gen_td_header_char( hdrbuf, hdrbufsize, itypesize, & ! hdrbufsize: Size of this data header in bytes. ! headerTag: "Header tag" that tells the I/O quilt servers what kind of ! header this is. For an "time-dependent string" header it must be -! set to int_dom_td_char. See file intio_tags.h for a complete +! set to INT_DOM_TD_CHAR. See file intio_tags.h for a complete ! list of these tags. ! DataHandle: Descriptor for an open data set. ! typesize: 1 (size in bytes of a single CHARACTER). @@ -937,7 +937,7 @@ SUBROUTINE int_gen_td_header_integer( hdrbuf, hdrbufsize, itypesize, typesize, & ! hdrbufsize: Size of this data header in bytes. ! headerTag: "Header tag" that tells the I/O quilt servers what kind of ! header this is. For an "time-dependent integer" header it must be -! set to int_dom_td_integer. See file intio_tags.h for a complete +! set to INT_DOM_TD_INTEGER. See file intio_tags.h for a complete ! list of these tags. ! DataHandle: Descriptor for an open data set. ! typesize: 1 (size in bytes of a single CHARACTER). @@ -1074,7 +1074,7 @@ SUBROUTINE int_gen_noop_header ( hdrbuf, hdrbufsize, itypesize ) ! hdrbufsize: Size of this data header in bytes. ! headerTag: "Header tag" that tells the I/O quilt servers what kind of ! header this is. For an "no-operation" header it must be -! set to int_noop. See file intio_tags.h for a complete +! set to INT_NOOP. See file intio_tags.h for a complete ! list of these tags. ! ! @@ -1087,7 +1087,7 @@ SUBROUTINE int_gen_noop_header ( hdrbuf, hdrbufsize, itypesize ) INTEGER i ! hdrbuf(1) = 0 !deferred - hdrbuf(2) = int_noop + hdrbuf(2) = INT_NOOP i = 3 hdrbufsize = (i-1) * itypesize ! return the number in bytes hdrbuf(1) = hdrbufsize @@ -1110,8 +1110,8 @@ SUBROUTINE int_get_noop_header( hdrbuf, hdrbufsize, itypesize ) INTEGER i ! hdrbufsize = hdrbuf(1) - IF ( hdrbuf(2) .NE. int_noop ) THEN - CALL wrf_error_fatal ( "int_get_noop_header: hdrbuf ne int_noop") + IF ( hdrbuf(2) .NE. INT_NOOP ) THEN + CALL wrf_error_fatal ( "int_get_noop_header: hdrbuf ne INT_NOOP") ENDIF i = 3 RETURN diff --git a/frame/module_io_quilt_old.F b/frame/module_io_quilt_old.F index e46d8b1095..69e443a69b 100644 --- a/frame/module_io_quilt_old.F +++ b/frame/module_io_quilt_old.F @@ -743,7 +743,7 @@ SUBROUTINE quilt ALLOCATE( obuf( 4096 ) ) ! DataHandle is provided as second element of reduced CALL int_gen_handle_header( obuf, obufsize, itypesize, & - reduced(2) , int_ioclose ) + reduced(2) , INT_IOCLOSE ) if(poll_servers) then ! Once we're done closing, we need to tell the master @@ -775,7 +775,7 @@ SUBROUTINE quilt DO WHILE ( icurs .lt. obufsize ) ! { hdr_tag = get_hdr_tag( obuf ( icurs / itypesize ) ) SELECT CASE ( hdr_tag ) - CASE ( int_field ) + CASE ( INT_FIELD ) CALL int_get_write_field_header ( obuf(icurs/itypesize), hdrbufsize, itypesize, ftypesize, & DataHandle , DateStr , VarName , Dummy , FieldType , Comm , IOComm, & DomainDesc , MemoryOrder , Stagger , DimNames , & @@ -806,7 +806,7 @@ SUBROUTINE quilt call add_to_bufsize_for_field( VarName, chunksize ) icurs = icurs + chunksize ENDIF - CASE ( int_open_for_write_commit ) ! only one per group of tasks + CASE ( INT_OPEN_FOR_WRITE_COMMIT ) ! only one per group of tasks hdrbufsize = obuf(icurs/itypesize) IF (num_commit_messages.EQ.0) THEN call add_to_bufsize_for_field( 'COMMIT', hdrbufsize ) @@ -851,14 +851,14 @@ SUBROUTINE quilt ! call to collect_on_comm: 1 bona fide output record from server task ! 0 and noops from the rest. - IF ((hdr_tag.EQ.int_noop.AND.mytask_local.NE.0.AND.num_noops.LE.0) & - .OR.hdr_tag.NE.int_noop) THEN + IF ((hdr_tag.EQ.INT_NOOP.AND.mytask_local.NE.0.AND.num_noops.LE.0) & + .OR.hdr_tag.NE.INT_NOOP) THEN write(VarName,'(I5.5)')vid !write(0,*) 'X-2', hdrbufsize, get_hdr_tag( obuf ( icurs / itypesize ) ) , get_hdr_rec_size( obuf ( icurs / itypesize ) ), TRIM(VarName) call add_to_bufsize_for_field( VarName, hdrbufsize ) vid = vid+1 ENDIF - IF ( hdr_tag .EQ. int_noop ) num_noops = num_noops + 1 + IF ( hdr_tag .EQ. INT_NOOP ) num_noops = num_noops + 1 icurs = icurs + hdrbufsize END SELECT ENDDO ! } @@ -874,7 +874,7 @@ SUBROUTINE quilt !write(0,*) 'A icurs ', icurs, ' obufsize ', obufsize hdr_tag = get_hdr_tag( obuf ( icurs / itypesize ) ) SELECT CASE ( hdr_tag ) - CASE ( int_field ) + CASE ( INT_FIELD ) CALL int_get_write_field_header ( obuf(icurs/itypesize), hdrbufsize, itypesize, ftypesize, & DataHandle , DateStr , VarName , Dummy , FieldType , Comm , IOComm, & DomainDesc , MemoryOrder , Stagger , DimNames , & @@ -902,7 +902,7 @@ SUBROUTINE quilt call store_piece_of_field( obuf(icurs/itypesize), VarName, chunksize ) icurs = icurs + chunksize ENDIF - CASE ( int_open_for_write_commit ) ! only one per group of tasks + CASE ( INT_OPEN_FOR_WRITE_COMMIT ) ! only one per group of tasks hdrbufsize = obuf(icurs/itypesize) IF (num_commit_messages.EQ.0) THEN call store_piece_of_field( obuf(icurs/itypesize), 'COMMIT', hdrbufsize ) @@ -911,14 +911,14 @@ SUBROUTINE quilt icurs = icurs + hdrbufsize CASE DEFAULT hdrbufsize = obuf(icurs/itypesize) - IF ((hdr_tag.EQ.int_noop.AND.mytask_local.NE.0.AND.num_noops.LE.0) & - .OR.hdr_tag.NE.int_noop) THEN + IF ((hdr_tag.EQ.INT_NOOP.AND.mytask_local.NE.0.AND.num_noops.LE.0) & + .OR.hdr_tag.NE.INT_NOOP) THEN write(VarName,'(I5.5)')vid !write(0,*) 'A-2b', hdrbufsize, get_hdr_tag( obuf ( icurs / itypesize ) ) , get_hdr_rec_size( obuf ( icurs / itypesize ) ), TRIM(VarName) call store_piece_of_field( obuf(icurs/itypesize), VarName, hdrbufsize ) vid = vid+1 ENDIF - IF ( hdr_tag .EQ. int_noop ) num_noops = num_noops + 1 + IF ( hdr_tag .EQ. INT_NOOP ) num_noops = num_noops + 1 icurs = icurs + hdrbufsize END SELECT ENDDO !} @@ -981,12 +981,12 @@ SUBROUTINE quilt ! actually quite easy. "Noop" requests exist to help avoid race conditions. ! In some cases, only one compute task will everything about a request so ! other compute tasks send "noop" requests. - CASE ( int_noop ) + CASE ( INT_NOOP ) CALL int_get_noop_header( bigbuf(icurs/itypesize), hdrbufsize, itypesize ) icurs = icurs + hdrbufsize ! The I/O server "root" handles the "put_dom_td_real" request. - CASE ( int_dom_td_real ) + CASE ( INT_DOM_TD_REAL ) CALL mpi_type_size( MPI_REAL, ftypesize, ierr ) ALLOCATE( RData( bigbuf(icurs/itypesize + 4 ) ) ) ! 5 is the count of data items for this record ; defined in collect_on_comm.c CALL int_get_td_header( bigbuf(icurs/itypesize:), hdrbufsize, itypesize, ftypesize, & @@ -1020,8 +1020,8 @@ SUBROUTINE quilt DEALLOCATE( RData ) ! The I/O server "root" handles the "put_dom_ti_real" request. - CASE ( int_dom_ti_real ) -!write(0,*)' int_dom_ti_real ' + CASE ( INT_DOM_TI_REAL ) +!write(0,*)' INT_DOM_TI_REAL ' CALL mpi_type_size( MPI_REAL, ftypesize, ierr ) ALLOCATE( RData( bigbuf(icurs/itypesize + 4 ) ) ) ! 5 is the count of data items for this record ; defined in collect_on_comm.c CALL int_get_ti_header( bigbuf(icurs/itypesize:), hdrbufsize, itypesize, ftypesize, & @@ -1057,8 +1057,8 @@ SUBROUTINE quilt DEALLOCATE( RData ) ! The I/O server "root" handles the "put_dom_td_integer" request. - CASE ( int_dom_td_integer ) -!write(0,*)' int_dom_td_integer ' + CASE ( INT_DOM_TD_INTEGER ) +!write(0,*)' INT_DOM_TD_INTEGER ' CALL mpi_type_size( MPI_INTEGER, ftypesize, ierr ) ALLOCATE( IData( bigbuf(icurs/itypesize + 4 ) ) ) ! 5 is the count of data items for this record ; defined in collect_on_comm.c CALL int_get_td_header( bigbuf(icurs/itypesize:), hdrbufsize, itypesize, ftypesize, & @@ -1093,8 +1093,8 @@ SUBROUTINE quilt DEALLOCATE( IData ) ! The I/O server "root" handles the "put_dom_ti_integer" request. - CASE ( int_dom_ti_integer ) -!write(0,*)' int_dom_ti_integer ' + CASE ( INT_DOM_TI_INTEGER ) +!write(0,*)' INT_DOM_TI_INTEGER ' CALL mpi_type_size( MPI_INTEGER, ftypesize, ierr ) ALLOCATE( IData( bigbuf(icurs/itypesize + 4 ) ) ) ! 5 is the count of data items for this record ; defined in collect_on_comm.c @@ -1131,8 +1131,8 @@ SUBROUTINE quilt DEALLOCATE( IData) ! The I/O server "root" handles the "set_time" request. - CASE ( int_set_time ) -!write(0,*)' int_set_time ' + CASE ( INT_SET_TIME ) +!write(0,*)' INT_SET_TIME ' CALL int_get_ti_header_char( bigbuf(icurs/itypesize), hdrbufsize, itypesize, & DataHandle, Element, VarName, CData, code ) SELECT CASE (use_package(io_form(DataHandle))) @@ -1147,7 +1147,7 @@ SUBROUTINE quilt icurs = icurs + hdrbufsize ! The I/O server "root" handles the "put_dom_ti_char" request. - CASE ( int_dom_ti_char ) + CASE ( INT_DOM_TI_CHAR ) !write(0,*)' before int_get_ti_header_char ' CALL int_get_ti_header_char( bigbuf(icurs/itypesize), hdrbufsize, itypesize, & DataHandle, Element, VarName, CData, code ) @@ -1181,8 +1181,8 @@ SUBROUTINE quilt icurs = icurs + hdrbufsize ! The I/O server "root" handles the "put_var_ti_char" request. - CASE ( int_var_ti_char ) -!write(0,*)' int_var_ti_char ' + CASE ( INT_VAR_TI_CHAR ) +!write(0,*)' INT_VAR_TI_CHAR ' CALL int_get_ti_header_char( bigbuf(icurs/itypesize), hdrbufsize, itypesize, & DataHandle, Element, VarName, CData, code ) @@ -1213,12 +1213,12 @@ SUBROUTINE quilt icurs = icurs + hdrbufsize - CASE ( int_ioexit ) + CASE ( INT_IOEXIT ) ! ioexit is now handled by sending negative message length to server CALL wrf_error_fatal( & - "quilt: should have handled int_ioexit already") + "quilt: should have handled INT_IOEXIT already") ! The I/O server "root" handles the "ioclose" request. - CASE ( int_ioclose ) + CASE ( INT_IOCLOSE ) CALL int_get_handle_header( bigbuf(icurs/itypesize), hdrbufsize, itypesize, & DataHandle , code ) icurs = icurs + hdrbufsize @@ -1281,17 +1281,17 @@ SUBROUTINE quilt ENDIF ! The I/O server "root" handles the "open_for_write_begin" request. - CASE ( int_open_for_write_begin ) + CASE ( INT_OPEN_FOR_WRITE_BEGIN ) CALL int_get_ofwb_header( bigbuf(icurs/itypesize), hdrbufsize, itypesize, & FileName,SysDepInfo,io_form_arg,DataHandle ) -!write(0,*)' int_open_for_write_begin itypesize ',itypesize,' itypesize ',itypesize -!write(0,*)' int_open_for_write_begin icurs ', icurs, hdrbufsize -!JMDEBUGwrite(0,*)' int_open_for_write_begin FileName ',TRIM(FileName) , ' DataHandle ', DataHandle -!write(0,*)' int_open_for_write_begin SysDepInfo ',TRIM(SysDepInfo) +!write(0,*)' INT_OPEN_FOR_WRITE_BEGIN itypesize ',itypesize,' itypesize ',itypesize +!write(0,*)' INT_OPEN_FOR_WRITE_BEGIN icurs ', icurs, hdrbufsize +!JMDEBUGwrite(0,*)' INT_OPEN_FOR_WRITE_BEGIN FileName ',TRIM(FileName) , ' DataHandle ', DataHandle +!write(0,*)' INT_OPEN_FOR_WRITE_BEGIN SysDepInfo ',TRIM(SysDepInfo) icurs = icurs + hdrbufsize -!write(0,*)' int_open_for_write_begin new icurs,tag,size ', icurs, get_hdr_tag( bigbuf(icurs/itypesize) ),get_hdr_rec_size( bigbuf(icurs/itypesize) ) +!write(0,*)' INT_OPEN_FOR_WRITE_BEGIN new icurs,tag,size ', icurs, get_hdr_tag( bigbuf(icurs/itypesize) ),get_hdr_rec_size( bigbuf(icurs/itypesize) ) io_form(DataHandle) = io_form_arg @@ -1327,14 +1327,14 @@ SUBROUTINE quilt ! In this case, the "okay_to_commit" is simply set to .true. so "write_field" ! requests will initiate writes to disk. Actual commit will be done after ! all requests in this batch have been handled. - CASE ( int_open_for_write_commit ) + CASE ( INT_OPEN_FOR_WRITE_COMMIT ) CALL int_get_handle_header( bigbuf(icurs/itypesize), hdrbufsize, itypesize, & DataHandle , code ) icurs = icurs + hdrbufsize okay_to_commit(DataHandle) = .true. -! The I/O server "root" handles the "write_field" (int_field) request. +! The I/O server "root" handles the "write_field" (INT_FIELD) request. ! If okay_to_write(DataHandle) is .true. then the patch in the ! header (bigbuf) is written to a globally-sized internal output buffer via ! the call to store_patch_in_outbuf(). Note that this is where the actual @@ -1342,9 +1342,9 @@ SUBROUTINE quilt ! okay_to_write(DataHandle) is .false. then external I/O package interfaces ! are called to write metadata for I/O formats that support native metadata. ! -! NOTE that the I/O server "root" will only see write_field (int_field) +! NOTE that the I/O server "root" will only see write_field (INT_FIELD) ! requests AFTER an "iosync" request. - CASE ( int_field ) + CASE ( INT_FIELD ) CALL mpi_type_size( MPI_INTEGER, ftypesize, ierr ) CALL int_get_write_field_header ( bigbuf(icurs/itypesize), hdrbufsize, itypesize, ftypesize, & DataHandle , DateStr , VarName , Dummy , FieldType , Comm , IOComm, & @@ -1352,7 +1352,7 @@ SUBROUTINE quilt DomainStart , DomainEnd , & MemoryStart , MemoryEnd , & PatchStart , PatchEnd ) -!write(0,*)' int_field ',TRIM(VarName),DataHandle,okay_to_write(DataHandle) +!write(0,*)' INT_FIELD ',TRIM(VarName),DataHandle,okay_to_write(DataHandle) icurs = icurs + hdrbufsize IF ( okay_to_write(DataHandle) ) THEN @@ -1418,7 +1418,7 @@ SUBROUTINE quilt Status = 0 END SELECT ENDIF - CASE ( int_iosync ) + CASE ( INT_IOSYNC ) CALL int_get_handle_header( bigbuf(icurs/itypesize), hdrbufsize, itypesize, & DataHandle , code ) icurs = icurs + hdrbufsize @@ -1436,7 +1436,7 @@ SUBROUTINE quilt ! (via a call to store_patch_in_outbuf()) then call write_outbuf() to write ! them to disk now. ! NOTE that the I/O server "root" will only have called -! store_patch_in_outbuf() when handling write_field (int_field) +! store_patch_in_outbuf() when handling write_field (INT_FIELD) ! commands which only arrive AFTER an "iosync" command. ! CALL start_timing CALL write_outbuf ( handle(DataHandle), use_package(io_form(DataHandle))) @@ -1745,7 +1745,7 @@ SUBROUTINE quilt_pnc ALLOCATE( obuf( 4096 ) ) ! DataHandle is provided as second element of reduced CALL int_gen_handle_header( obuf, obufsize, itypesize, & - reduced(2) , int_ioclose ) + reduced(2) , INT_IOCLOSE ) ENDIF !write(0,*)'calling init_store_piece_of_field' @@ -1772,7 +1772,7 @@ SUBROUTINE quilt_pnc DO WHILE ( icurs .lt. obufsize ) ! { hdr_tag = get_hdr_tag( obuf ( icurs / itypesize ) ) SELECT CASE ( hdr_tag ) - CASE ( int_field ) + CASE ( INT_FIELD ) CALL int_get_write_field_header ( obuf(icurs/itypesize), hdrbufsize, itypesize, ftypesize, & DataHandle , DateStr , VarName , Dummy , FieldType , Comm , IOComm, & DomainDesc , MemoryOrder , Stagger , DimNames , & @@ -1803,7 +1803,7 @@ SUBROUTINE quilt_pnc call add_to_bufsize_for_field( VarName, chunksize ) icurs = icurs + chunksize ENDIF - CASE ( int_open_for_write_commit ) ! only one per group of tasks + CASE ( INT_OPEN_FOR_WRITE_COMMIT ) ! only one per group of tasks hdrbufsize = obuf(icurs/itypesize) IF (num_commit_messages.EQ.0) THEN call add_to_bufsize_for_field( 'COMMIT', hdrbufsize ) @@ -1841,13 +1841,13 @@ SUBROUTINE quilt_pnc ! 5. Logic below does not allow any noop records through since each IO ! server task now receives a valid record (from the 'compute-group master' ! when doing replicated output - IF (hdr_tag.NE.int_noop) THEN + IF (hdr_tag.NE.INT_NOOP) THEN write(VarName,'(I5.5)')vid !write(0,*) 'X-2', hdrbufsize, get_hdr_tag( obuf ( icurs / itypesize ) ) , get_hdr_rec_size( obuf ( icurs / itypesize ) ), TRIM(VarName) call add_to_bufsize_for_field( VarName, hdrbufsize ) vid = vid+1 ENDIF - IF ( hdr_tag .EQ. int_noop ) num_noops = num_noops + 1 + IF ( hdr_tag .EQ. INT_NOOP ) num_noops = num_noops + 1 icurs = icurs + hdrbufsize END SELECT @@ -1864,7 +1864,7 @@ SUBROUTINE quilt_pnc !write(0,*) 'A icurs ', icurs, ' obufsize ', obufsize hdr_tag = get_hdr_tag( obuf ( icurs / itypesize ) ) SELECT CASE ( hdr_tag ) - CASE ( int_field ) + CASE ( INT_FIELD ) CALL int_get_write_field_header ( obuf(icurs/itypesize), hdrbufsize, itypesize, ftypesize, & DataHandle , DateStr , VarName , Dummy , FieldType , Comm , IOComm, & DomainDesc , MemoryOrder , Stagger , DimNames , & @@ -1892,7 +1892,7 @@ SUBROUTINE quilt_pnc icurs = icurs + chunksize !write(0,*) 'A-1a',TRIM(VarName),' icurs ',icurs,PatchStart(1:3),PatchEnd(1:3) ENDIF - CASE ( int_open_for_write_commit ) ! only one per group of tasks + CASE ( INT_OPEN_FOR_WRITE_COMMIT ) ! only one per group of tasks hdrbufsize = obuf(icurs/itypesize) IF (num_commit_messages.EQ.0) THEN call store_piece_of_field( obuf(icurs/itypesize), 'COMMIT', hdrbufsize ) @@ -1901,14 +1901,14 @@ SUBROUTINE quilt_pnc icurs = icurs + hdrbufsize CASE DEFAULT hdrbufsize = obuf(icurs/itypesize) - IF (hdr_tag.NE.int_noop) THEN + IF (hdr_tag.NE.INT_NOOP) THEN write(VarName,'(I5.5)')vid !write(0,*) 'A-2b', hdrbufsize, get_hdr_tag( obuf ( icurs / itypesize ) ) , get_hdr_rec_size( obuf ( icurs / itypesize ) ), TRIM(VarName) call store_piece_of_field( obuf(icurs/itypesize), VarName, hdrbufsize ) vid = vid+1 ENDIF - IF ( hdr_tag .EQ. int_noop ) num_noops = num_noops + 1 + IF ( hdr_tag .EQ. INT_NOOP ) num_noops = num_noops + 1 icurs = icurs + hdrbufsize END SELECT ENDDO !} while(icurs < obufsize) @@ -1942,13 +1942,13 @@ SUBROUTINE quilt_pnc SELECT CASE ( get_hdr_tag( obuf(icurs/itypesize) ) ) ! The I/O server handles the "noop" (do nothing) request. This is ! actually quite easy. "Noop" requests exist to help avoid race conditions. - CASE ( int_noop ) + CASE ( INT_NOOP ) CALL int_get_noop_header( obuf(icurs/itypesize), & hdrbufsize, itypesize ) icurs = icurs + hdrbufsize ! The I/O server "root" handles the "put_dom_td_real" request. - CASE ( int_dom_td_real ) + CASE ( INT_DOM_TD_REAL ) CALL mpi_type_size( MPI_REAL, ftypesize, ierr ) ALLOCATE( RData( obuf(icurs/itypesize + 4 ) ) ) ! 5 is the count of data items for this record ; defined in collect_on_comm.c CALL int_get_td_header( obuf(icurs/itypesize:), hdrbufsize, itypesize, ftypesize, & @@ -1986,7 +1986,7 @@ SUBROUTINE quilt_pnc DEALLOCATE( RData ) ! Every I/O server handles the "put_dom_ti_real" request. - CASE ( int_dom_ti_real ) + CASE ( INT_DOM_TI_REAL ) CALL mpi_type_size( MPI_REAL, ftypesize, ierr ) ALLOCATE( RData( obuf(icurs/itypesize + 4 ) ) ) ! 5 is the count of data items for this record ; defined in collect_on_comm.c @@ -2026,7 +2026,7 @@ SUBROUTINE quilt_pnc DEALLOCATE( RData ) ! Every I/O server handles the "put_dom_td_integer" request. - CASE ( int_dom_td_integer ) + CASE ( INT_DOM_TD_INTEGER ) CALL mpi_type_size( MPI_INTEGER, ftypesize, ierr ) ALLOCATE( IData( obuf(icurs/itypesize + 4 ) ) ) ! 5 is the count of data items for this record ; defined in collect_on_comm.c @@ -2066,7 +2066,7 @@ SUBROUTINE quilt_pnc DEALLOCATE( IData ) ! Every I/O server handles the "put_dom_ti_integer" request. - CASE ( int_dom_ti_integer ) + CASE ( INT_DOM_TI_INTEGER ) CALL mpi_type_size( MPI_INTEGER, ftypesize, ierr ) ALLOCATE( IData( obuf(icurs/itypesize + 4 ) ) ) ! 5 is the count of data items for this record ; defined in collect_on_comm.c @@ -2106,7 +2106,7 @@ SUBROUTINE quilt_pnc DEALLOCATE( IData) ! Every I/O server handles the "set_time" request. - CASE ( int_set_time ) + CASE ( INT_SET_TIME ) CALL int_get_ti_header_char( obuf(icurs/itypesize), hdrbufsize, itypesize, & DataHandle, Element, VarName, CData, code ) @@ -2122,7 +2122,7 @@ SUBROUTINE quilt_pnc icurs = icurs + hdrbufsize ! Every I/O server handles the "put_dom_ti_char" request. - CASE ( int_dom_ti_char ) + CASE ( INT_DOM_TI_CHAR ) CALL int_get_ti_header_char( obuf(icurs/itypesize), hdrbufsize, itypesize, & DataHandle, Element, VarName, CData, code ) @@ -2159,7 +2159,7 @@ SUBROUTINE quilt_pnc icurs = icurs + hdrbufsize ! Every I/O server handles the "put_var_ti_char" request. - CASE ( int_var_ti_char ) + CASE ( INT_VAR_TI_CHAR ) CALL int_get_ti_header_char( obuf(icurs/itypesize), hdrbufsize, itypesize, & DataHandle, Element, VarName, CData, code ) @@ -2195,12 +2195,12 @@ SUBROUTINE quilt_pnc icurs = icurs + hdrbufsize - CASE ( int_ioexit ) + CASE ( INT_IOEXIT ) ! ioexit is now handled by sending negative message length to server CALL wrf_error_fatal( & - "quilt: should have handled int_ioexit already") + "quilt: should have handled INT_IOEXIT already") ! Every I/O server handles the "ioclose" request. - CASE ( int_ioclose ) + CASE ( INT_IOCLOSE ) CALL int_get_handle_header( obuf(icurs/itypesize), hdrbufsize, itypesize, & DataHandle , code ) icurs = icurs + hdrbufsize @@ -2256,17 +2256,17 @@ SUBROUTINE quilt_pnc ENDIF ! Every I/O server handles the "open_for_write_begin" request. - CASE ( int_open_for_write_begin ) + CASE ( INT_OPEN_FOR_WRITE_BEGIN ) CALL int_get_ofwb_header( obuf(icurs/itypesize), hdrbufsize, itypesize, & FileName,SysDepInfo,io_form_arg,DataHandle ) -!write(0,*)' int_open_for_write_begin itypesize ',itypesize,' itypesize ',itypesize -!write(0,*)' int_open_for_write_begin icurs ', icurs, hdrbufsize -!JMDEBUGwrite(0,*)' int_open_for_write_begin FileName ',TRIM(FileName) , ' DataHandle ', DataHandle -!write(0,*)' int_open_for_write_begin SysDepInfo ',TRIM(SysDepInfo) +!write(0,*)' INT_OPEN_FOR_WRITE_BEGIN itypesize ',itypesize,' itypesize ',itypesize +!write(0,*)' INT_OPEN_FOR_WRITE_BEGIN icurs ', icurs, hdrbufsize +!JMDEBUGwrite(0,*)' INT_OPEN_FOR_WRITE_BEGIN FileName ',TRIM(FileName) , ' DataHandle ', DataHandle +!write(0,*)' INT_OPEN_FOR_WRITE_BEGIN SysDepInfo ',TRIM(SysDepInfo) icurs = icurs + hdrbufsize -!write(0,*)' int_open_for_write_begin new icurs,tag,size ', icurs, get_hdr_tag( bigbuf(icurs/itypesize) ),get_hdr_rec_size( bigbuf(icurs/itypesize) ) +!write(0,*)' INT_OPEN_FOR_WRITE_BEGIN new icurs,tag,size ', icurs, get_hdr_tag( bigbuf(icurs/itypesize) ),get_hdr_rec_size( bigbuf(icurs/itypesize) ) io_form(DataHandle) = io_form_arg @@ -2304,25 +2304,25 @@ SUBROUTINE quilt_pnc ! Every I/O server handles the "open_for_write_commit" request. ! In this case, the "okay_to_commit" is simply set to .true. so "write_field" -! (int_field) requests will initiate writes to disk. Actual commit will be done after +! (INT_FIELD) requests will initiate writes to disk. Actual commit will be done after ! all requests in this batch have been handled. - CASE ( int_open_for_write_commit ) + CASE ( INT_OPEN_FOR_WRITE_COMMIT ) CALL int_get_handle_header( obuf(icurs/itypesize), hdrbufsize, itypesize, & DataHandle , code ) icurs = icurs + hdrbufsize okay_to_commit(DataHandle) = .true. -! Every I/O server handles the "write_field" (int_field) request. +! Every I/O server handles the "write_field" (INT_FIELD) request. ! If okay_to_write(DataHandle) is .true. then the patch in the ! header (bigbuf) is written to disk using pNetCDF. Note that this is where the actual ! "quilting" (reassembly of patches onto a full-size domain) is done. If ! okay_to_write(DataHandle) is .false. then external I/O package interfaces ! are called to write metadata for I/O formats that support native metadata. ! -! NOTE that the I/O servers will only see write_field (int_field) +! NOTE that the I/O servers will only see write_field (INT_FIELD) ! requests AFTER an "iosync" request. - CASE ( int_field ) + CASE ( INT_FIELD ) CALL mpi_type_size( MPI_INTEGER, ftypesize, ierr ) CALL int_get_write_field_header ( obuf(icurs/itypesize), hdrbufsize, itypesize, ftypesize, & DataHandle , DateStr , VarName , Dummy , FieldType , Comm , IOComm, & @@ -2330,7 +2330,7 @@ SUBROUTINE quilt_pnc DomainStart , DomainEnd , & MemoryStart , MemoryEnd , & PatchStart , PatchEnd ) -!write(0,*)' int_field ',TRIM(VarName),DataHandle,okay_to_write(DataHandle) +!write(0,*)' INT_FIELD ',TRIM(VarName),DataHandle,okay_to_write(DataHandle) icurs = icurs + hdrbufsize IF ( okay_to_write(DataHandle) ) THEN @@ -2445,7 +2445,7 @@ SUBROUTINE quilt_pnc Status = 0 END SELECT ENDIF - CASE ( int_iosync ) + CASE ( INT_IOSYNC ) CALL int_get_handle_header( obuf(icurs/itypesize), hdrbufsize, itypesize, & DataHandle , code ) icurs = icurs + hdrbufsize @@ -2465,7 +2465,7 @@ SUBROUTINE quilt_pnc ! (via a call to store_patch_in_outbuf_pnc()) then call write_outbuf_pnc() ! to write them to disk now. ! NOTE that the I/O server will only have called -! store_patch_in_outbuf() when handling write_field (int_field) +! store_patch_in_outbuf() when handling write_field (INT_FIELD) ! commands which only arrive AFTER an "iosync" command. ! CALL start_timing #ifdef PNETCDF_QUILT @@ -3088,7 +3088,7 @@ SUBROUTINE wrf_quilt_open_for_write_commit( DataHandle , Status ) !ARP parallel IO IF(compute_group_master(1)) THEN CALL int_gen_handle_header( hdrbuf, hdrbufsize, itypesize, & - DataHandle, int_open_for_write_commit ) + DataHandle, INT_OPEN_FOR_WRITE_COMMIT ) ELSE CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize ) END IF @@ -3096,7 +3096,7 @@ SUBROUTINE wrf_quilt_open_for_write_commit( DataHandle , Status ) IF ( wrf_dm_on_monitor() ) THEN CALL int_gen_handle_header( hdrbuf, hdrbufsize, itypesize, & - DataHandle, int_open_for_write_commit ) + DataHandle, INT_OPEN_FOR_WRITE_COMMIT ) ELSE CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize ) ENDIF @@ -3336,14 +3336,14 @@ SUBROUTINE wrf_quilt_ioclose ( DataHandle, Status ) #ifdef PNETCDF_QUILT IF ( compute_group_master(1) )THEN CALL int_gen_handle_header( hdrbuf, hdrbufsize, itypesize, & - DataHandle, int_ioclose ) + DataHandle, INT_IOCLOSE ) ELSE CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize ) ENDIF #else IF ( wrf_dm_on_monitor() ) THEN CALL int_gen_handle_header( hdrbuf, hdrbufsize, itypesize, & - DataHandle , int_ioclose ) + DataHandle , INT_IOCLOSE ) ELSE CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize ) ENDIF @@ -3420,7 +3420,7 @@ SUBROUTINE wrf_quilt_ioexit( Status ) !ARP Send the ioexit message just once to each IOServer when using parallel IO IF( compute_group_master(1) ) THEN CALL int_gen_handle_header( hdrbuf, hdrbufsize, itypesize, & - DataHandle, int_ioexit ) + DataHandle, INT_IOEXIT ) ELSE CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize ) END IF @@ -3428,7 +3428,7 @@ SUBROUTINE wrf_quilt_ioexit( Status ) IF ( wrf_dm_on_monitor() ) THEN CALL int_gen_handle_header( hdrbuf, hdrbufsize, itypesize, & - DataHandle , int_ioexit ) ! Handle is dummy + DataHandle , INT_IOEXIT ) ! Handle is dummy ELSE CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize ) ENDIF @@ -3532,14 +3532,14 @@ SUBROUTINE wrf_quilt_set_time ( DataHandle, Data, Status ) ! can't tell that's what they are on the IO servers themselves - therefore use ! the compute_group_master process. CALL int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, & - DataHandle, "TIMESTAMP", "", Data, int_set_time ) + DataHandle, "TIMESTAMP", "", Data, INT_SET_TIME ) ELSE CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize ) END IF #else IF ( wrf_dm_on_monitor() ) THEN CALL int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, & - DataHandle, "TIMESTAMP", "", Data, int_set_time ) + DataHandle, "TIMESTAMP", "", Data, INT_SET_TIME ) ELSE CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize ) ENDIF @@ -3648,14 +3648,14 @@ SUBROUTINE wrf_quilt_put_dom_ti_real ( DataHandle,Element, Data, Count, Statu #ifdef PNETCDF_QUILT IF ( compute_group_master(1) ) THEN CALL int_gen_ti_header( hdrbuf, hdrbufsize, itypesize, typesize, & - DataHandle, locElement, Data, Count, int_dom_ti_real ) + DataHandle, locElement, Data, Count, INT_DOM_TI_REAL ) ELSE CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize ) ENDIF #else IF ( wrf_dm_on_monitor() ) THEN CALL int_gen_ti_header( hdrbuf, hdrbufsize, itypesize, typesize, & - DataHandle, locElement, Data, Count, int_dom_ti_real ) + DataHandle, locElement, Data, Count, INT_DOM_TI_REAL ) ELSE CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize ) ENDIF @@ -3806,7 +3806,7 @@ SUBROUTINE wrf_quilt_put_dom_ti_integer ( DataHandle,Element, Data, Count, St IF ( compute_group_master(1) )THEN CALL int_gen_ti_header( hdrbuf, hdrbufsize, itypesize, typesize, & DataHandle, locElement, Data, Count, & - int_dom_ti_integer ) + INT_DOM_TI_INTEGER ) ELSE CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize ) ENDIF @@ -3814,7 +3814,7 @@ SUBROUTINE wrf_quilt_put_dom_ti_integer ( DataHandle,Element, Data, Count, St IF ( wrf_dm_on_monitor() ) THEN CALL int_gen_ti_header( hdrbuf, hdrbufsize, itypesize, typesize, & DataHandle, locElement, Data, Count, & - int_dom_ti_integer ) + INT_DOM_TI_INTEGER ) ELSE CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize ) ENDIF @@ -3966,14 +3966,14 @@ SUBROUTINE wrf_quilt_put_dom_ti_char ( DataHandle, Element, Data, Status ) IF(compute_group_master(1))THEN CALL int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, & DataHandle, Element, "", Data, & - int_dom_ti_char ) + INT_DOM_TI_CHAR ) ELSE CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize ) END IF #else IF ( wrf_dm_on_monitor() ) THEN CALL int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, & - DataHandle, Element, "", Data, int_dom_ti_char ) + DataHandle, Element, "", Data, INT_DOM_TI_CHAR ) ELSE CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize ) ENDIF @@ -4510,7 +4510,7 @@ SUBROUTINE wrf_quilt_put_var_ti_char ( DataHandle,Element, Varname, Data, Stat IF ( compute_group_master(1) ) THEN CALL int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, & DataHandle, TRIM(Element), & - TRIM(VarName), TRIM(Data), int_var_ti_char ) + TRIM(VarName), TRIM(Data), INT_VAR_TI_CHAR ) ELSE CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize ) ENDIF @@ -4518,7 +4518,7 @@ SUBROUTINE wrf_quilt_put_var_ti_char ( DataHandle,Element, Varname, Data, Stat IF ( wrf_dm_on_monitor() ) THEN CALL int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, & DataHandle, TRIM(Element), & - TRIM(VarName), TRIM(Data), int_var_ti_char ) + TRIM(VarName), TRIM(Data), INT_VAR_TI_CHAR ) ELSE CALL int_gen_noop_header( hdrbuf, hdrbufsize, itypesize ) ENDIF @@ -4852,7 +4852,7 @@ SUBROUTINE wrf_quilt_write_field ( DataHandle , DateStr , VarName , Field , Fiel ! During a "real" write, this routine begins by allocating ! int_local_output_buffer if it has not already been allocated. Sizes ! accumulated during "training" are used to determine how big -! int_local_output_buffer must be. This routine then stores "int_field" +! int_local_output_buffer must be. This routine then stores "INT_FIELD" ! headers and associated field data in int_local_output_buffer. The contents ! of int_local_output_buffer are actually sent to the I/O quilt server in ! routine wrf_quilt_iosync(). This scheme allows output of multiple variables From 1ac5eda89ab61fbc7273c1616cc151237233b98c Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Wed, 17 May 2023 16:51:30 -0600 Subject: [PATCH 03/41] Removing redundant files --- external/io_grib1/wrf_status_codes.h | 133 -------------------- external/io_grib_share/wrf_io_flags.h | 16 --- external/io_grib_share/wrf_status_codes.h | 142 ---------------------- 3 files changed, 291 deletions(-) delete mode 100644 external/io_grib1/wrf_status_codes.h delete mode 100644 external/io_grib_share/wrf_io_flags.h delete mode 100644 external/io_grib_share/wrf_status_codes.h diff --git a/external/io_grib1/wrf_status_codes.h b/external/io_grib1/wrf_status_codes.h deleted file mode 100644 index 059d9ea719..0000000000 --- a/external/io_grib1/wrf_status_codes.h +++ /dev/null @@ -1,133 +0,0 @@ - -!WRF Error and Warning messages (1-999) -!All i/o package-specific status codes you may want to add must be handled by your package (see below) -! WRF handles these and netCDF messages only - integer, parameter :: WRF_NO_ERR = 0 !no error - integer, parameter :: WRF_WARN_FILE_NF = -1 !file not found, or incomplete - integer, parameter :: WRF_WARN_MD_NF = -2 !metadata not found - integer, parameter :: WRF_WARN_TIME_NF = -3 !timestamp not found - integer, parameter :: WRF_WARN_TIME_EOF = -4 !no more timestamps - integer, parameter :: WRF_WARN_VAR_NF = -5 !variable not found - integer, parameter :: WRF_WARN_VAR_EOF = -6 !no more variables for the current time - integer, parameter :: WRF_WARN_TOO_MANY_FILES = -7 !too many open files - integer, parameter :: WRF_WARN_TYPE_MISMATCH = -8 !data type mismatch - integer, parameter :: WRF_WARN_WRITE_RONLY_FILE = -9 !attempt to write readonly file - integer, parameter :: WRF_WARN_READ_WONLY_FILE = -10 !attempt to read writeonly file - integer, parameter :: WRF_WARN_FILE_NOT_OPENED = -11 !attempt to access unopened file - integer, parameter :: WRF_WARN_2DRYRUNS_1VARIABLE = -12 !attempt to do 2 trainings for 1 variable - integer, parameter :: WRF_WARN_READ_PAST_EOF = -13 !attempt to read past EOF - integer, parameter :: WRF_WARN_BAD_DATA_HANDLE = -14 !bad data handle - integer, parameter :: WRF_WARN_WRTLEN_NE_DRRUNLEN = -15 !write length not equal to training length - integer, parameter :: WRF_WARN_TOO_MANY_DIMS = -16 !more dimensions requested than training - integer, parameter :: WRF_WARN_COUNT_TOO_LONG = -17 !attempt to read more data than exists - integer, parameter :: WRF_WARN_DIMENSION_ERROR = -18 !input dimension inconsistent - integer, parameter :: WRF_WARN_BAD_MEMORYORDER = -19 !input MemoryOrder not recognized - integer, parameter :: WRF_WARN_DIMNAME_REDEFINED = -20 !a dimension name with 2 different lengths - integer, parameter :: WRF_WARN_CHARSTR_GT_LENDATA = -21 !string longer than provided storage - integer, parameter :: WRF_WARN_NOTSUPPORTED = -22 !function not supportable - integer, parameter :: WRF_WARN_NOOP = -23 !package implements this routine as NOOP - -!Fatal errors - integer, parameter :: WRF_ERR_FATAL_ALLOCATION_ERROR = -100 !allocation error - integer, parameter :: WRF_ERR_FATAL_DEALLOCATION_ERR = -101 !dealloc error - integer, parameter :: WRF_ERR_FATAL_BAD_FILE_STATUS = -102 !bad file status - - -!Package specific errors (1000+) -!Netcdf status codes -!WRF will accept status codes of 1000+, but it is up to the package to handle -! and return the status to the user. - - integer, parameter :: WRF_ERR_FATAL_BAD_VARIABLE_DIM = -1004 - integer, parameter :: WRF_ERR_FATAL_MDVAR_DIM_NOT_1D = -1005 - integer, parameter :: WRF_ERR_FATAL_TOO_MANY_TIMES = -1006 - integer, parameter :: WRF_WARN_BAD_DATA_TYPE = -1007 !this code not in either spec? - integer, parameter :: WRF_WARN_FILE_NOT_COMMITTED = -1008 !this code not in either spec? - integer, parameter :: WRF_WARN_FILE_OPEN_FOR_READ = -1009 - integer, parameter :: WRF_IO_NOT_INITIALIZED = -1010 - integer, parameter :: WRF_WARN_MD_AFTER_OPEN = -1011 - integer, parameter :: WRF_WARN_TOO_MANY_VARIABLES = -1012 - integer, parameter :: WRF_WARN_DRYRUN_CLOSE = -1013 - integer, parameter :: WRF_WARN_DATESTR_BAD_LENGTH = -1014 - integer, parameter :: WRF_WARN_ZERO_LENGTH_READ = -1015 - integer, parameter :: WRF_WARN_DATA_TYPE_NOT_FOUND = -1016 - integer, parameter :: WRF_WARN_DATESTR_ERROR = -1017 - integer, parameter :: WRF_WARN_DRYRUN_READ = -1018 - integer, parameter :: WRF_WARN_ZERO_LENGTH_GET = -1019 - integer, parameter :: WRF_WARN_ZERO_LENGTH_PUT = -1020 - integer, parameter :: WRF_WARN_NETCDF = -1021 - integer, parameter :: WRF_WARN_LENGTH_LESS_THAN_1 = -1022 - integer, parameter :: WRF_WARN_MORE_DATA_IN_FILE = -1023 - integer, parameter :: WRF_WARN_DATE_LT_LAST_DATE = -1024 - -! For HDF5 only - integer, parameter :: WRF_HDF5_ERR_FILE = -200 - integer, parameter :: WRF_HDF5_ERR_MD = -201 - integer, parameter :: WRF_HDF5_ERR_TIME = -202 - integer, parameter :: WRF_HDF5_ERR_TIME_EOF = -203 - integer, parameter :: WRF_HDF5_ERR_MORE_DATA_IN_FILE = -204 - integer, parameter :: WRF_HDF5_ERR_DATE_LT_LAST_DATE = -205 - integer, parameter :: WRF_HDF5_ERR_TOO_MANY_FILES = -206 - integer, parameter :: WRF_HDF5_ERR_TYPE_MISMATCH = -207 - integer, parameter :: WRF_HDF5_ERR_LENGTH_LESS_THAN_1 = -208 - integer, parameter :: WRF_HDF5_ERR_WRITE_RONLY_FILE = -209 - integer, parameter :: WRF_HDF5_ERR_READ_WONLY_FILE = -210 - integer, parameter :: WRF_HDF5_ERR_FILE_NOT_OPENED = -211 - integer, parameter :: WRF_HDF5_ERR_DATESTR_ERROR = -212 - integer, parameter :: WRF_HDF5_ERR_DRYRUN_READ = -213 - integer, parameter :: WRF_HDF5_ERR_ZERO_LENGTH_GET = -214 - integer, parameter :: WRF_HDF5_ERR_ZERO_LENGTH_PUT = -215 - integer, parameter :: WRF_HDF5_ERR_2DRYRUNS_1VARIABLE = -216 - integer, parameter :: WRF_HDF5_ERR_DATA_TYPE_NOTFOUND = -217 - integer, parameter :: WRF_HDF5_ERR_READ_PAST_EOF = -218 - integer, parameter :: WRF_HDF5_ERR_BAD_DATA_HANDLE = -219 - integer, parameter :: WRF_HDF5_ERR_WRTLEN_NE_DRRUNLEN = -220 - integer, parameter :: WRF_HDF5_ERR_DRYRUN_CLOSE = -221 - integer, parameter :: WRF_HDF5_ERR_DATESTR_BAD_LENGTH = -222 - integer, parameter :: WRF_HDF5_ERR_ZERO_LENGTH_READ = -223 - integer, parameter :: WRF_HDF5_ERR_TOO_MANY_DIMS = -224 - integer, parameter :: WRF_HDF5_ERR_TOO_MANY_VARIABLES = -225 - integer, parameter :: WRF_HDF5_ERR_COUNT_TOO_LONG = -226 - integer, parameter :: WRF_HDF5_ERR_DIMENSION_ERROR = -227 - integer, parameter :: WRF_HDF5_ERR_BAD_MEMORYORDER = -228 - integer, parameter :: WRF_HDF5_ERR_DIMNAME_REDEFINED = -229 - integer, parameter :: WRF_HDF5_ERR_MD_AFTER_OPEN = -230 - integer, parameter :: WRF_HDF5_ERR_CHARSTR_GT_LENDATA = -231 - integer, parameter :: WRF_HDF5_ERR_BAD_DATA_TYPE = -232 - integer, parameter :: WRF_HDF5_ERR_FILE_NOT_COMMITTED = -233 - - integer, parameter :: WRF_HDF5_ERR_ALLOCATION = -2001 - integer, parameter :: WRF_HDF5_ERR_DEALLOCATION = -2002 - integer, parameter :: WRF_HDF5_ERR_BAD_FILE_STATUS = -2003 - integer, parameter :: WRF_HDF5_ERR_BAD_VARIABLE_DIM = -2004 - integer, parameter :: WRF_HDF5_ERR_MDVAR_DIM_NOT_1D = -2005 - integer, parameter :: WRF_HDF5_ERR_TOO_MANY_TIMES = -2006 - integer, parameter :: WRF_HDF5_ERR_DATA_ID_NOTFOUND = -2007 - - integer, parameter :: WRF_HDF5_ERR_DATASPACE = -300 - integer, parameter :: WRF_HDF5_ERR_DATATYPE = -301 - integer, parameter :: WRF_HDF5_ERR_PROPERTY_LIST = -302 - - integer, parameter :: WRF_HDF5_ERR_DATASET_CREATE = -303 - integer, parameter :: WRF_HDF5_ERR_DATASET_READ = -304 - integer, parameter :: WRF_HDF5_ERR_DATASET_WRITE = -305 - integer, parameter :: WRF_HDF5_ERR_DATASET_OPEN = -306 - integer, parameter :: WRF_HDF5_ERR_DATASET_GENERAL = -307 - integer, parameter :: WRF_HDF5_ERR_GROUP = -308 - - integer, parameter :: WRF_HDF5_ERR_FILE_OPEN = -309 - integer, parameter :: WRF_HDF5_ERR_FILE_CREATE = -310 - integer, parameter :: WRF_HDF5_ERR_DATASET_CLOSE = -311 - integer, parameter :: WRF_HDF5_ERR_FILE_CLOSE = -312 - integer, parameter :: WRF_HDF5_ERR_CLOSE_GENERAL = -313 - - integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_CREATE = -314 - integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_READ = -315 - integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_WRITE = -316 - integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_OPEN = -317 - integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_GENERAL = -318 - integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_CLOSE = -319 - - integer, parameter :: WRF_HDF5_ERR_OTHERS = -320 - integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_OTHERS = -321 - diff --git a/external/io_grib_share/wrf_io_flags.h b/external/io_grib_share/wrf_io_flags.h deleted file mode 100644 index 708939f914..0000000000 --- a/external/io_grib_share/wrf_io_flags.h +++ /dev/null @@ -1,16 +0,0 @@ - integer, parameter :: WRF_FILE_NOT_OPENED = 100 - integer, parameter :: WRF_FILE_OPENED_NOT_COMMITTED = 101 - integer, parameter :: WRF_FILE_OPENED_FOR_WRITE = 102 - integer, parameter :: WRF_FILE_OPENED_FOR_READ = 103 - integer, parameter :: WRF_REAL = 104 - integer, parameter :: WRF_DOUBLE = 105 -#ifdef PROMOTE_FLOAT - integer, parameter :: WRF_FLOAT=WRF_DOUBLE -#else - integer, parameter :: WRF_FLOAT=WRF_REAL -#endif - integer, parameter :: WRF_INTEGER = 106 - integer, parameter :: WRF_LOGICAL = 107 - integer, parameter :: WRF_COMPLEX = 108 - integer, parameter :: WRF_DOUBLE_COMPLEX = 109 - integer, parameter :: WRF_FILE_OPENED_FOR_UPDATE = 110 diff --git a/external/io_grib_share/wrf_status_codes.h b/external/io_grib_share/wrf_status_codes.h deleted file mode 100644 index 008ac5ce76..0000000000 --- a/external/io_grib_share/wrf_status_codes.h +++ /dev/null @@ -1,142 +0,0 @@ - -!WRF Error and Warning messages (1-999) -!All i/o package-specific status codes you may want to add must be handled by your package (see below) -! WRF handles these and netCDF messages only - integer, parameter :: WRF_NO_ERR = 0 !no error - integer, parameter :: WRF_WARN_FILE_NF = -1 !file not found, or incomplete - integer, parameter :: WRF_WARN_MD_NF = -2 !metadata not found - integer, parameter :: WRF_WARN_TIME_NF = -3 !timestamp not found - integer, parameter :: WRF_WARN_TIME_EOF = -4 !no more timestamps - integer, parameter :: WRF_WARN_VAR_NF = -5 !variable not found - integer, parameter :: WRF_WARN_VAR_EOF = -6 !no more variables for the current time - integer, parameter :: WRF_WARN_TOO_MANY_FILES = -7 !too many open files - integer, parameter :: WRF_WARN_TYPE_MISMATCH = -8 !data type mismatch - integer, parameter :: WRF_WARN_WRITE_RONLY_FILE = -9 !attempt to write readonly file - integer, parameter :: WRF_WARN_READ_WONLY_FILE = -10 !attempt to read writeonly file - integer, parameter :: WRF_WARN_FILE_NOT_OPENED = -11 !attempt to access unopened file - integer, parameter :: WRF_WARN_2DRYRUNS_1VARIABLE = -12 !attempt to do 2 trainings for 1 variable - integer, parameter :: WRF_WARN_READ_PAST_EOF = -13 !attempt to read past EOF - integer, parameter :: WRF_WARN_BAD_DATA_HANDLE = -14 !bad data handle - integer, parameter :: WRF_WARN_WRTLEN_NE_DRRUNLEN = -15 !write length not equal to training length - integer, parameter :: WRF_WARN_TOO_MANY_DIMS = -16 !more dimensions requested than training - integer, parameter :: WRF_WARN_COUNT_TOO_LONG = -17 !attempt to read more data than exists - integer, parameter :: WRF_WARN_DIMENSION_ERROR = -18 !input dimension inconsistent - integer, parameter :: WRF_WARN_BAD_MEMORYORDER = -19 !input MemoryOrder not recognized - integer, parameter :: WRF_WARN_DIMNAME_REDEFINED = -20 !a dimension name with 2 different lengths - integer, parameter :: WRF_WARN_CHARSTR_GT_LENDATA = -21 !string longer than provided storage - integer, parameter :: WRF_WARN_NOTSUPPORTED = -22 !function not supportable - integer, parameter :: WRF_WARN_NOOP = -23 !package implements this routine as NOOP - -!Fatal errors - integer, parameter :: WRF_ERR_FATAL_ALLOCATION_ERROR = -100 !allocation error - integer, parameter :: WRF_ERR_FATAL_DEALLOCATION_ERR = -101 !dealloc error - integer, parameter :: WRF_ERR_FATAL_BAD_FILE_STATUS = -102 !bad file status - - -!Package specific errors (1000+) -!Netcdf status codes -!WRF will accept status codes of 1000+, but it is up to the package to handle -! and return the status to the user. - - integer, parameter :: WRF_ERR_FATAL_BAD_VARIABLE_DIM = -1004 - integer, parameter :: WRF_ERR_FATAL_MDVAR_DIM_NOT_1D = -1005 - integer, parameter :: WRF_ERR_FATAL_TOO_MANY_TIMES = -1006 - integer, parameter :: WRF_WARN_BAD_DATA_TYPE = -1007 !this code not in either spec? - integer, parameter :: WRF_WARN_FILE_NOT_COMMITTED = -1008 !this code not in either spec? - integer, parameter :: WRF_WARN_FILE_OPEN_FOR_READ = -1009 - integer, parameter :: WRF_IO_NOT_INITIALIZED = -1010 - integer, parameter :: WRF_WARN_MD_AFTER_OPEN = -1011 - integer, parameter :: WRF_WARN_TOO_MANY_VARIABLES = -1012 - integer, parameter :: WRF_WARN_DRYRUN_CLOSE = -1013 - integer, parameter :: WRF_WARN_DATESTR_BAD_LENGTH = -1014 - integer, parameter :: WRF_WARN_ZERO_LENGTH_READ = -1015 - integer, parameter :: WRF_WARN_DATA_TYPE_NOT_FOUND = -1016 - integer, parameter :: WRF_WARN_DATESTR_ERROR = -1017 - integer, parameter :: WRF_WARN_DRYRUN_READ = -1018 - integer, parameter :: WRF_WARN_ZERO_LENGTH_GET = -1019 - integer, parameter :: WRF_WARN_ZERO_LENGTH_PUT = -1020 - integer, parameter :: WRF_WARN_NETCDF = -1021 - integer, parameter :: WRF_WARN_LENGTH_LESS_THAN_1 = -1022 - integer, parameter :: WRF_WARN_MORE_DATA_IN_FILE = -1023 - integer, parameter :: WRF_WARN_DATE_LT_LAST_DATE = -1024 - -! For HDF5 only - integer, parameter :: WRF_HDF5_ERR_FILE = -200 - integer, parameter :: WRF_HDF5_ERR_MD = -201 - integer, parameter :: WRF_HDF5_ERR_TIME = -202 - integer, parameter :: WRF_HDF5_ERR_TIME_EOF = -203 - integer, parameter :: WRF_HDF5_ERR_MORE_DATA_IN_FILE = -204 - integer, parameter :: WRF_HDF5_ERR_DATE_LT_LAST_DATE = -205 - integer, parameter :: WRF_HDF5_ERR_TOO_MANY_FILES = -206 - integer, parameter :: WRF_HDF5_ERR_TYPE_MISMATCH = -207 - integer, parameter :: WRF_HDF5_ERR_LENGTH_LESS_THAN_1 = -208 - integer, parameter :: WRF_HDF5_ERR_WRITE_RONLY_FILE = -209 - integer, parameter :: WRF_HDF5_ERR_READ_WONLY_FILE = -210 - integer, parameter :: WRF_HDF5_ERR_FILE_NOT_OPENED = -211 - integer, parameter :: WRF_HDF5_ERR_DATESTR_ERROR = -212 - integer, parameter :: WRF_HDF5_ERR_DRYRUN_READ = -213 - integer, parameter :: WRF_HDF5_ERR_ZERO_LENGTH_GET = -214 - integer, parameter :: WRF_HDF5_ERR_ZERO_LENGTH_PUT = -215 - integer, parameter :: WRF_HDF5_ERR_2DRYRUNS_1VARIABLE = -216 - integer, parameter :: WRF_HDF5_ERR_DATA_TYPE_NOTFOUND = -217 - integer, parameter :: WRF_HDF5_ERR_READ_PAST_EOF = -218 - integer, parameter :: WRF_HDF5_ERR_BAD_DATA_HANDLE = -219 - integer, parameter :: WRF_HDF5_ERR_WRTLEN_NE_DRRUNLEN = -220 - integer, parameter :: WRF_HDF5_ERR_DRYRUN_CLOSE = -221 - integer, parameter :: WRF_HDF5_ERR_DATESTR_BAD_LENGTH = -222 - integer, parameter :: WRF_HDF5_ERR_ZERO_LENGTH_READ = -223 - integer, parameter :: WRF_HDF5_ERR_TOO_MANY_DIMS = -224 - integer, parameter :: WRF_HDF5_ERR_TOO_MANY_VARIABLES = -225 - integer, parameter :: WRF_HDF5_ERR_COUNT_TOO_LONG = -226 - integer, parameter :: WRF_HDF5_ERR_DIMENSION_ERROR = -227 - integer, parameter :: WRF_HDF5_ERR_BAD_MEMORYORDER = -228 - integer, parameter :: WRF_HDF5_ERR_DIMNAME_REDEFINED = -229 - integer, parameter :: WRF_HDF5_ERR_MD_AFTER_OPEN = -230 - integer, parameter :: WRF_HDF5_ERR_CHARSTR_GT_LENDATA = -231 - integer, parameter :: WRF_HDF5_ERR_BAD_DATA_TYPE = -232 - integer, parameter :: WRF_HDF5_ERR_FILE_NOT_COMMITTED = -233 - - integer, parameter :: WRF_HDF5_ERR_ALLOCATION = -2001 - integer, parameter :: WRF_HDF5_ERR_DEALLOCATION = -2002 - integer, parameter :: WRF_HDF5_ERR_BAD_FILE_STATUS = -2003 - integer, parameter :: WRF_HDF5_ERR_BAD_VARIABLE_DIM = -2004 - integer, parameter :: WRF_HDF5_ERR_MDVAR_DIM_NOT_1D = -2005 - integer, parameter :: WRF_HDF5_ERR_TOO_MANY_TIMES = -2006 - integer, parameter :: WRF_HDF5_ERR_DATA_ID_NOTFOUND = -2007 - - integer, parameter :: WRF_HDF5_ERR_DATASPACE = -300 - integer, parameter :: WRF_HDF5_ERR_DATATYPE = -301 - integer, parameter :: WRF_HDF5_ERR_PROPERTY_LIST = -302 - - integer, parameter :: WRF_HDF5_ERR_DATASET_CREATE = -303 - integer, parameter :: WRF_HDF5_ERR_DATASET_READ = -304 - integer, parameter :: WRF_HDF5_ERR_DATASET_WRITE = -305 - integer, parameter :: WRF_HDF5_ERR_DATASET_OPEN = -306 - integer, parameter :: WRF_HDF5_ERR_DATASET_GENERAL = -307 - integer, parameter :: WRF_HDF5_ERR_GROUP = -308 - - integer, parameter :: WRF_HDF5_ERR_FILE_OPEN = -309 - integer, parameter :: WRF_HDF5_ERR_FILE_CREATE = -310 - integer, parameter :: WRF_HDF5_ERR_DATASET_CLOSE = -311 - integer, parameter :: WRF_HDF5_ERR_FILE_CLOSE = -312 - integer, parameter :: WRF_HDF5_ERR_CLOSE_GENERAL = -313 - - integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_CREATE = -314 - integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_READ = -315 - integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_WRITE = -316 - integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_OPEN = -317 - integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_GENERAL = -318 - integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_CLOSE = -319 - - integer, parameter :: WRF_HDF5_ERR_OTHERS = -320 - integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_OTHERS = -321 - - integer, parameter :: WRF_GRIB2_ERR_GRIBCREATE = -401 - integer, parameter :: WRF_GRIB2_ERR_ADDLOCAL = -402 - integer, parameter :: WRF_GRIB2_ERR_ADDGRIB = -403 - integer, parameter :: WRF_GRIB2_ERR_ADDFIELD = -404 - integer, parameter :: WRF_GRIB2_ERR_GRIBEND = -405 - integer, parameter :: WRF_GRIB2_ERR_WRITE = -406 - integer, parameter :: WRF_GRIB2_ERR_GRIB2MAP = -407 - integer, parameter :: WRF_GRIB2_ERR_GETGB2 = -408 - integer, parameter :: WRF_GRIB2_ERR_READ = -409 From c14c44306a8acb7bd0d8aca422cd81065d11a608 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Wed, 17 May 2023 16:55:53 -0600 Subject: [PATCH 04/41] Reworking external/ build --- external/ioapi_share/wrf_status_codes.h | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/external/ioapi_share/wrf_status_codes.h b/external/ioapi_share/wrf_status_codes.h index 98484da413..8dfb44b53e 100644 --- a/external/ioapi_share/wrf_status_codes.h +++ b/external/ioapi_share/wrf_status_codes.h @@ -132,3 +132,12 @@ integer, parameter :: WRF_HDF5_ERR_OTHERS = -320 integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_OTHERS = -321 + integer, parameter :: WRF_GRIB2_ERR_GRIBCREATE = -401 + integer, parameter :: WRF_GRIB2_ERR_ADDLOCAL = -402 + integer, parameter :: WRF_GRIB2_ERR_ADDGRIB = -403 + integer, parameter :: WRF_GRIB2_ERR_ADDFIELD = -404 + integer, parameter :: WRF_GRIB2_ERR_GRIBEND = -405 + integer, parameter :: WRF_GRIB2_ERR_WRITE = -406 + integer, parameter :: WRF_GRIB2_ERR_GRIB2MAP = -407 + integer, parameter :: WRF_GRIB2_ERR_GETGB2 = -408 + integer, parameter :: WRF_GRIB2_ERR_READ = -409 From af9be8585431f4ea3d71d1ec95c9ead490235f9a Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Wed, 5 Jul 2023 18:24:30 -0600 Subject: [PATCH 05/41] Adjusting include paths for removal of redundant code --- external/io_grib1/Makefile | 2 +- external/io_grib_share/Makefile | 6 +++--- external/io_int/makefile | 5 +---- 3 files changed, 5 insertions(+), 8 deletions(-) diff --git a/external/io_grib1/Makefile b/external/io_grib1/Makefile index 6afcf4d760..a222b2dbfe 100644 --- a/external/io_grib1/Makefile +++ b/external/io_grib1/Makefile @@ -10,7 +10,7 @@ # # Specity location for Makefiles that are included. # -INCLUDEDIRS = -I. -I./MEL_grib1 -Igrib1_util -I../io_grib_share -I../ +INCLUDEDIRS = -I. -I./MEL_grib1 -Igrib1_util -I../io_grib_share -I../ -I../ioapi_share BUILD_DIR = $(IO_GRIB_SHARE_DIR)../io_grib_share/build # # Specify directory that output library is to be put in. diff --git a/external/io_grib_share/Makefile b/external/io_grib_share/Makefile index 41d3c96659..5e3a59db55 100644 --- a/external/io_grib_share/Makefile +++ b/external/io_grib_share/Makefile @@ -22,9 +22,9 @@ LIB_DEST = . # CXX_INCLUDES is for C++ files # C_INCLUDES is for C files # -C_INCLUDES = -I. -CXX_INCLUDES = -I. -F_INCLUDES = -I. +C_INCLUDES = -I. -I../ioapi_share +CXX_INCLUDES = -I. -I../ioapi_share +F_INCLUDES = -I. -I../ioapi_share AR = ar ARFLAGS = cruv diff --git a/external/io_int/makefile b/external/io_int/makefile index 3033670e32..7bc484968e 100644 --- a/external/io_int/makefile +++ b/external/io_int/makefile @@ -32,11 +32,8 @@ io_int.f: io_int.F90 module_internal_header_util.o io_int.o: io_int.f ../../inc/intio_tags.h $(FC) $(FCFLAGS) -I../../inc -I../ioapi_share -o $@ -c $*.f -io_int_idx_tags.h: ../../inc/intio_tags.h - awk '{print "#define", toupper($$4), $$6}' < ../../inc/intio_tags.h > $@ - io_int_idx.o: io_int_idx.c io_int_idx.h io_int_idx_tags.h - $(CC) -o $@ -c $(CFLAGS_LOCAL) $*.c + $(CC) -I../../inc -o $@ -c $(CFLAGS_LOCAL) $*.c module_io_int_idx.o: module_io_int_idx.f $(FC) $(FCFLAGS) -o $@ -c $*.f From 68b1fca5a7277402605e0da2d6c779127e25d3d8 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Mon, 17 Jul 2023 15:44:09 -0600 Subject: [PATCH 06/41] Remove all references to idx tags autogen file --- external/io_int/makefile | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/external/io_int/makefile b/external/io_int/makefile index 7bc484968e..e52b7c7bef 100644 --- a/external/io_int/makefile +++ b/external/io_int/makefile @@ -32,7 +32,7 @@ io_int.f: io_int.F90 module_internal_header_util.o io_int.o: io_int.f ../../inc/intio_tags.h $(FC) $(FCFLAGS) -I../../inc -I../ioapi_share -o $@ -c $*.f -io_int_idx.o: io_int_idx.c io_int_idx.h io_int_idx_tags.h +io_int_idx.o: io_int_idx.c io_int_idx.h $(CC) -I../../inc -o $@ -c $(CFLAGS_LOCAL) $*.c module_io_int_idx.o: module_io_int_idx.f @@ -88,5 +88,5 @@ test_io_mpi: test_io_mpi.f90 $(LIB) $(FC) $(FCFLAGS) $(LDFLAGS) -o $@ $@.f90 -L. -lwrfio_int superclean: - @$(RM) *.f *.o *.obj *.i *.mod $(LIB) diffwrf io_int_idx_tags.h \ - test_io_idx test_io_mpi io_int_idx_tags.h + @$(RM) *.f *.o *.obj *.i *.mod $(LIB) diffwrf \ + test_io_idx test_io_mpi From ab17f26afdb7b89974e19f88fc36fa6f713b766e Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Thu, 4 May 2023 11:42:10 -0600 Subject: [PATCH 07/41] Fairly confident this was a bug --- tools/gen_allocs.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/gen_allocs.c b/tools/gen_allocs.c index c7e7953257..abafbcb893 100644 --- a/tools/gen_allocs.c +++ b/tools/gen_allocs.c @@ -659,7 +659,7 @@ gen_dealloc2 ( FILE * fp , char * structname , node_t * node ) fprintf(fp, " DEALLOCATE(%s%s,STAT=ierr)\n if (ierr.ne.0) then\n CALL wrf_error_fatal ( &\n'frame/module_domain.f: Failed to deallocate %s%s. ')\n endif\n", structname, fname, structname, fname ) ; -#ifdef USE_ALLOCATABLES +#ifndef USE_ALLOCATABLES fprintf(fp, " NULLIFY(%s%s)\n",structname, fname ) ; #endif From 06e80784da378bdde501f89041abe07aadf5547b Mon Sep 17 00:00:00 2001 From: Tao Sun <41139193+mos3r3n@users.noreply.github.com> Date: Thu, 4 Jan 2024 15:19:41 -0700 Subject: [PATCH 08/41] bugfix for the lightning DA (#1970) Bugfix for the lightning DA TYPE: bug fix DESCRIPTION OF CHANGES: There are some bugs in the [PR#1962](https://github.com/wrf-model/WRF/pull/1962), which is fixed in this PR. LIST OF MODIFIED FILES: M var/da/da_minimisation/da_get_var_diagnostics.inc M var/da/da_statistics/da_analysis_stats.inc TESTS CONDUCTED: 1. Tested using the GNU compiler on Derecho. --- var/da/da_minimisation/da_get_var_diagnostics.inc | 2 +- var/da/da_statistics/da_analysis_stats.inc | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/var/da/da_minimisation/da_get_var_diagnostics.inc b/var/da/da_minimisation/da_get_var_diagnostics.inc index c25236728d..aba293bcf1 100644 --- a/var/da/da_minimisation/da_get_var_diagnostics.inc +++ b/var/da/da_minimisation/da_get_var_diagnostics.inc @@ -13,7 +13,7 @@ subroutine da_get_var_diagnostics(it, iv, j) integer :: num_stats_tot integer :: i,k real :: jo_radiance - real :: temp(79) + real :: temp(82) if (trace_use) call da_trace_entry("da_get_var_diagnostics") diff --git a/var/da/da_statistics/da_analysis_stats.inc b/var/da/da_statistics/da_analysis_stats.inc index 652dbc9ba3..7ac2c831b2 100644 --- a/var/da/da_statistics/da_analysis_stats.inc +++ b/var/da/da_statistics/da_analysis_stats.inc @@ -85,7 +85,7 @@ use module_state_description, only : num_chem, PARAM_FIRST_SCALAR 'p i j ', & 'q i j' case ( 1 ) - write(unit=stats_unit, fmt='(8a/)') & + write(unit=stats_unit, fmt='(9a/)') & ' Lvl ', & 'u i j ', & 'v i j ', & @@ -397,7 +397,7 @@ use module_state_description, only : num_chem, PARAM_FIRST_SCALAR 'p i j ', & 'q i j' case ( 1 ) - write(unit=stats_unit, fmt='(8a/)') & + write(unit=stats_unit, fmt='(9a/)') & ' Lvl ', & 'u i j ', & 'v i j ', & @@ -1080,9 +1080,9 @@ use module_state_description, only : num_chem, PARAM_FIRST_SCALAR qcim=qcim+qciv(k) qsnm=qsnm+qsnv(k) end if - if ( use_cv_w ) then - wm=wm+wv(k) - end if + if ( use_cv_w ) then + wm=wm+wv(k) + end if end do !k loop end if !rootproc From 278a36481782d417a6f6b0655e8e14f502433677 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Mon, 8 May 2023 19:01:59 -0600 Subject: [PATCH 09/41] Making registry work in out of source build --- tools/gen_streams.c | 4 +++- tools/reg_parse.c | 15 +++++++++++---- 2 files changed, 14 insertions(+), 5 deletions(-) diff --git a/tools/gen_streams.c b/tools/gen_streams.c index f93cf3989d..e6cbda002d 100644 --- a/tools/gen_streams.c +++ b/tools/gen_streams.c @@ -607,12 +607,14 @@ gen_med_find_esmf_coupling ( FILE *fp ) for each stream. This file is then included by the registry.io_boilerplate file when the registry actually runs. As with the other mods above, this allows a variable, compile-time number of io streams. Note that this one is self contained and dirname is hard-coded. + AI: In an effort to delineate true source files from autogen stuff this is now not going into hard-coded + Registry so that we can use ./ as an alternate include location */ int gen_io_boilerplate () { FILE * fp ; - char * dirname = "Registry" ; + char * dirname = "./" ; char fname[NAMELEN] ; char * fn ; char * aux , *streamtype , streamno[5] ; diff --git a/tools/reg_parse.c b/tools/reg_parse.c index 01176c0ea4..5321b58402 100644 --- a/tools/reg_parse.c +++ b/tools/reg_parse.c @@ -116,21 +116,28 @@ pre_parse( char * dir, FILE * infile, FILE * outfile ) for ( p = inln ; ( *p == ' ' || *p == ' ' ) && *p != '\0' ; p++ ) ; if ( !strncmp( p , "include", 7 ) && ! ( ifdef_stack_ptr >= 0 && ! ifdef_stack[ifdef_stack_ptr] ) ) { FILE *include_fp ; + char include_file_name_dir[128] ; char include_file_name[128] ; p += 7 ; for ( ; ( *p == ' ' || *p == ' ' ) && *p != '\0' ; p++ ) ; if ( strlen( p ) > 127 ) { fprintf(stderr,"Registry warning: invalid include file name: %s\n", p ) ; } else { - sprintf( include_file_name , "%s/%s", dir , p ) ; + + sprintf( include_file_name, "%s", p ) ; if ( (p=index(include_file_name,'\n')) != NULL ) *p = '\0' ; + sprintf( include_file_name_dir, "%s/%s", dir , include_file_name ) ; + fprintf(stderr,"opening %s\n",include_file_name) ; - if (( include_fp = fopen( include_file_name , "r" )) != NULL ) { + if ( ( ( include_fp = fopen( include_file_name, "r" ) ) != NULL ) || // Use short circuit logic here to try both sequentially + ( ( include_fp = fopen( include_file_name_dir, "r" ) ) != NULL ) ) + { fprintf(stderr,"including %s\n",include_file_name ) ; pre_parse( dir , include_fp , outfile ) ; fclose( include_fp ) ; - } else { - fprintf(stderr,"Registry warning: cannot open %s. Ignoring.\n", include_file_name ) ; + } + else { + fprintf(stderr,"Registry warning: cannot open %s. Tried %s and %s Ignoring.\n", include_file_name, include_file_name, include_file_name_dir ) ; } } } From 28641519b9840e02fc4e0021e1f0f34fd6b674b3 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Thu, 4 May 2023 11:42:41 -0600 Subject: [PATCH 10/41] Adding nonzero macro check for function returns rather than failing silently --- tools/registry.c | 75 +++++++++++++++++++++++++----------------------- 1 file changed, 39 insertions(+), 36 deletions(-) diff --git a/tools/registry.c b/tools/registry.c index 79f7983ed7..937cef5a18 100644 --- a/tools/registry.c +++ b/tools/registry.c @@ -18,6 +18,9 @@ #include "data.h" #include "sym.h" +// Helper macro to actually do return checks +#define NON_ZERO_RETURN( A ) { int result = A; if ( result != 0 ) { printf( "Error in %s, non-zero return expected", #A ); exit(result); } } + /* SamT: bug fix: main returns int */ int main( int argc, char *argv[], char *env[] ) @@ -132,11 +135,11 @@ main( int argc, char *argv[], char *env[] ) argv++ ; } - gen_io_boilerplate() ; /* 20091213 jm. Generate the io_boilerplate_temporary.inc file */ + NON_ZERO_RETURN( gen_io_boilerplate() ); /* 20091213 jm. Generate the io_boilerplate_temporary.inc file */ - init_parser() ; - init_type_table() ; - init_dim_table() ; + NON_ZERO_RETURN( init_parser() ); + NON_ZERO_RETURN( init_type_table() ); + NON_ZERO_RETURN( init_dim_table() ); // // possible IRR diagnostcis? // @@ -230,45 +233,45 @@ main( int argc, char *argv[], char *env[] ) } - reg_parse(fp_tmp) ; + NON_ZERO_RETURN( reg_parse(fp_tmp) ); fclose(fp_tmp) ; - check_dimspecs() ; + NON_ZERO_RETURN( check_dimspecs() ); - gen_state_struct( "inc" ) ; - gen_state_subtypes( "inc" ) ; - gen_alloc( "inc" ) ; + NON_ZERO_RETURN( gen_state_struct( "inc" ) ); + NON_ZERO_RETURN( gen_state_subtypes( "inc" ) ); + NON_ZERO_RETURN( gen_alloc( "inc" ) ); /* gen_alloc_count( "inc" ) ; */ - gen_dealloc( "inc" ) ; - gen_scalar_indices( "inc" ) ; - gen_module_state_description( "frame" ) ; - gen_actual_args( "inc" ) ; - gen_actual_args_new( "inc" ) ; - gen_dummy_args( "inc" ) ; - gen_dummy_args_new( "inc" ) ; - gen_dummy_decls( "inc" ) ; - gen_dummy_decls_new( "inc" ) ; - gen_i1_decls( "inc" ) ; - gen_namelist_statements("inc") ; - gen_namelist_defines ( "inc", 0 ) ; /* without dimension statements */ - gen_namelist_defines ( "inc", 1 ) ; /* with dimension statements */ - gen_namelist_defaults ( "inc" ) ; - gen_namelist_script ( "inc" ) ; - gen_get_nl_config( "inc" ) ; - gen_config_assigns( "inc" ) ; - gen_config_reads( "inc" ) ; - gen_wrf_io( "inc" ) ; - gen_model_data_ord( "inc" ) ; - gen_nest_interp( "inc" ) ; - gen_nest_v_interp( "inc") ; /*KAL added this for vertical interpolation*/ - gen_scalar_derefs( "inc" ) ; - gen_streams("inc") ; + NON_ZERO_RETURN( gen_dealloc( "inc" ) ) ; + NON_ZERO_RETURN( gen_scalar_indices( "inc" ) ) ; + NON_ZERO_RETURN( gen_module_state_description( "frame" ) ) ; + NON_ZERO_RETURN( gen_actual_args( "inc" ) ) ; + NON_ZERO_RETURN( gen_actual_args_new( "inc" ) ) ; + NON_ZERO_RETURN( gen_dummy_args( "inc" ) ) ; + NON_ZERO_RETURN( gen_dummy_args_new( "inc" ) ) ; + NON_ZERO_RETURN( gen_dummy_decls( "inc" ) ) ; + NON_ZERO_RETURN( gen_dummy_decls_new( "inc" ) ) ; + NON_ZERO_RETURN( gen_i1_decls( "inc" ) ) ; + NON_ZERO_RETURN( gen_namelist_statements("inc") ; ) + NON_ZERO_RETURN( gen_namelist_defines ( "inc", 0 ) ) ; /* without dimension statements */ + NON_ZERO_RETURN( gen_namelist_defines ( "inc", 1 ) ) ; /* with dimension statements */ + NON_ZERO_RETURN( gen_namelist_defaults ( "inc" ) ) ; + NON_ZERO_RETURN( gen_namelist_script ( "inc" ) ) ; + NON_ZERO_RETURN( gen_get_nl_config( "inc" ) ) ; + NON_ZERO_RETURN( gen_config_assigns( "inc" ) ) ; + NON_ZERO_RETURN( gen_config_reads( "inc" ) ) ; + NON_ZERO_RETURN( gen_wrf_io( "inc" ) ) ; + NON_ZERO_RETURN( gen_model_data_ord( "inc" ) ) ; + NON_ZERO_RETURN( gen_nest_interp( "inc" ) ) ; + NON_ZERO_RETURN( gen_nest_v_interp( "inc") ; ) /*KAL added this for vertical interpolation*/ + NON_ZERO_RETURN( gen_scalar_derefs( "inc" ) ) ; + NON_ZERO_RETURN( gen_streams("inc") ; ) /* this has to happen after gen_nest_interp, which adds halos to the AST */ - gen_comms( "inc" ) ; /* this is either package supplied (by copying a */ - /* gen_comms.c file into this directory) or a */ - /* stubs routine. */ + NON_ZERO_RETURN( gen_comms( "inc" ) ); /* this is either package supplied (by copying a */ + /* gen_comms.c file into this directory) or a */ + /* stubs routine. */ cleanup: #ifdef _WIN32 From a9b538c4bce172b69212a530e200369fbc561765 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Wed, 19 Jul 2023 13:37:29 -0600 Subject: [PATCH 11/41] Removing dimspec check since some configurations fail silently --- tools/registry.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/registry.c b/tools/registry.c index 937cef5a18..97759b0942 100644 --- a/tools/registry.c +++ b/tools/registry.c @@ -237,7 +237,7 @@ main( int argc, char *argv[], char *env[] ) fclose(fp_tmp) ; - NON_ZERO_RETURN( check_dimspecs() ); + check_dimspecs(); NON_ZERO_RETURN( gen_state_struct( "inc" ) ); NON_ZERO_RETURN( gen_state_subtypes( "inc" ) ); From bd764e04616f2143edb866af8ae916f647482095 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Thu, 4 May 2023 11:40:50 -0600 Subject: [PATCH 12/41] Ignoring _build directory --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index eca261d36e..c47fe3e850 100644 --- a/.gitignore +++ b/.gitignore @@ -17,3 +17,4 @@ configure.wrf* *.backup *.f90 +_build/ \ No newline at end of file From c3fb7013565af073b3b0993dadfdea1fd1cf7e5f Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Tue, 23 May 2023 12:45:51 -0600 Subject: [PATCH 13/41] Adding runtime generated files to ignore list --- .gitignore | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/.gitignore b/.gitignore index c47fe3e850..26a74951f6 100644 --- a/.gitignore +++ b/.gitignore @@ -17,4 +17,17 @@ configure.wrf* *.backup *.f90 -_build/ \ No newline at end of file +_build/ +# New (and old) things we should ignore +wrf_config.cmake +*.nc +rsl.out.* +rsl.error.* +ndown +real +tc +ideal +wrf +wrfbdy_d* +wrfinput_d* +wrfout_d* \ No newline at end of file From 389c36c4e73451b29179f7cbc8e39ebdd342bedb Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Thu, 4 May 2023 11:38:33 -0600 Subject: [PATCH 14/41] Modifying #ifdef structure for cmake syntax --- external/atm_ocn/cmpcomm.F | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/external/atm_ocn/cmpcomm.F b/external/atm_ocn/cmpcomm.F index a78e285337..89cd554e1c 100644 --- a/external/atm_ocn/cmpcomm.F +++ b/external/atm_ocn/cmpcomm.F @@ -1,4 +1,4 @@ -#if defined( DM_PARALLEL ) +#ifdef DM_PARALLEL MODULE CMP_COMM implicit none From 050fe8cee57acecd2f0a570554db7297b65af4ce Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Thu, 4 May 2023 11:39:04 -0600 Subject: [PATCH 15/41] Modifying #ifdef structure for cmake syntax --- frame/module_configure.F | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/frame/module_configure.F b/frame/module_configure.F index 4e0ae808c3..8554a7d92a 100644 --- a/frame/module_configure.F +++ b/frame/module_configure.F @@ -15,7 +15,8 @@ SUBROUTINE init_module_scalar_tables END SUBROUTINE init_module_scalar_tables END MODULE module_scalar_tables -#if( WRF_CHEM == 1 && WRF_KPP == 1 ) +#ifdef WRF_CHEM +#ifdef WRF_KPP MODULE module_irr_diag INTEGER, parameter :: max_eqn = 1200 @@ -45,6 +46,7 @@ END SUBROUTINE init_module_irr_diag END MODULE module_irr_diag #endif +#endif MODULE module_configure From eb0d0764ef58ea7caad9de9112256d29f85be840 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Wed, 10 May 2023 11:33:59 -0600 Subject: [PATCH 16/41] Simplifying #if[n]defs --- dyn_em/module_advect_em.F | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/dyn_em/module_advect_em.F b/dyn_em/module_advect_em.F index ff03d1a695..2913ac5a9c 100644 --- a/dyn_em/module_advect_em.F +++ b/dyn_em/module_advect_em.F @@ -1,7 +1,7 @@ !WRF:MODEL_LAYER:DYNAMICS ! -#if ( defined(ADVECT_KERNEL) ) +#ifdef ADVECT_KERNEL ! cpp -traditional-cpp -P -DADVECT_KERNEL module_advect_em.F > advection_kernel.f90 ! gfortran -ffree-form -ffree-line-length-none advection_kernel.f90 ! ./a.out @@ -111,7 +111,7 @@ SUBROUTINE column (loop , data_list, its,ite) END SUBROUTINE column !---------------------------------------------------------------- -#elif ( ! defined(ADVECT_KERNEL) ) +#else MODULE module_advect_em @@ -4357,7 +4357,7 @@ SUBROUTINE advect_scalar ( field, field_old, tendency, & ENDIF vert_order_test END SUBROUTINE advect_scalar -#if ( ! defined(ADVECT_KERNEL) ) +#ifndef ADVECT_KERNEL !--------------------------------------------------------------------------------- @@ -10543,7 +10543,7 @@ END SUBROUTINE advect_scalar_mono !----------------------------------------------------------- -#if ( defined(ADVECT_KERNEL) ) +#ifdef ADVECT_KERNEL END MODULE advection_kernel !================================================================ @@ -10851,7 +10851,7 @@ PROGRAM feeder END PROGRAM feeder #endif -#if ( !defined(ADVECT_KERNEL) ) +#ifndef ADVECT_KERNEL !--------------------------------------------------------------------------------- From 1bf491045324ad5f01aec693d60b2928f1b02450 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Fri, 23 Jun 2023 20:08:21 -0600 Subject: [PATCH 17/41] Add comments to old c preproc / m4 processing since gfortran is unable to --- external/io_adios2/wrf_io.F90 | 6 +++--- external/io_netcdf/wrf_io.F90 | 4 ++-- external/io_netcdfpar/wrf_io.F90 | 4 ++-- external/io_pnetcdf/wrf_io.F90 | 2 +- 4 files changed, 8 insertions(+), 8 deletions(-) diff --git a/external/io_adios2/wrf_io.F90 b/external/io_adios2/wrf_io.F90 index 3d5fdd6844..d53ad88481 100644 --- a/external/io_adios2/wrf_io.F90 +++ b/external/io_adios2/wrf_io.F90 @@ -702,9 +702,9 @@ subroutine Transpose(IO,MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 & call LowerCase(MemoryOrder,MemOrd) select case (MemOrd) - - !#define XDEX(A,B,C) A-A ## 1+1+(A ## 2-A ## 1+1)*((B-B ## 1)+(C-C ## 1)*(B ## 2-B ## 1+1)) - ! define(`XDEX',($1-``$1''1+1+(``$1''2-``$1''1+1)*(($2-``$2''1)+($3-``$3''1)*(``$2''2-``$2''1+1)))) +! Cannot use following define due to gfortran cpp traditional mode concatenation limitations +!#define XDEX(A,B,C) A-A ## 1+1+(A ## 2-A ## 1+1)*((B-B ## 1)+(C-C ## 1)*(B ## 2-B ## 1+1)) +! define(`XDEX',($1-``$1''1+1+(``$1''2-``$1''1+1)*(($2-``$2''1)+($3-``$3''1)*(``$2''2-``$2''1+1)))) case ('xzy') #undef DFIELD #define DFIELD XField(1:di,XDEX(i,k,j)) diff --git a/external/io_netcdf/wrf_io.F90 b/external/io_netcdf/wrf_io.F90 index ec2162d2d5..8863e4e29f 100644 --- a/external/io_netcdf/wrf_io.F90 +++ b/external/io_netcdf/wrf_io.F90 @@ -754,7 +754,7 @@ subroutine Transpose(IO,MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 & call LowerCase(MemoryOrder,MemOrd) select case (MemOrd) - +! Cannot use following define due to gfortran cpp traditional mode concatenation limitations !#define XDEX(A,B,C) A-A ## 1+1+(A ## 2-A ## 1+1)*((B-B ## 1)+(C-C ## 1)*(B ## 2-B ## 1+1)) ! define(`XDEX',($1-``$1''1+1+(``$1''2-``$1''1+1)*(($2-``$2''1)+($3-``$3''1)*(``$2''2-``$2''1+1)))) @@ -940,7 +940,7 @@ subroutine TransposeToR4(IO,MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 & call LowerCase(MemoryOrder,MemOrd) select case (MemOrd) - +! Cannot use following define due to gfortran cpp traditional mode concatenation limitations !#define XDEX(A,B,C) A-A ## 1+1+(A ## 2-A ## 1+1)*((B-B ## 1)+(C-C ## 1)*(B ## 2-B ## 1+1)) ! define(`XDEX',($1-``$1''1+1+(``$1''2-``$1''1+1)*(($2-``$2''1)+($3-``$3''1)*(``$2''2-``$2''1+1)))) diff --git a/external/io_netcdfpar/wrf_io.F90 b/external/io_netcdfpar/wrf_io.F90 index a76ec5d82d..86e25dd2cb 100644 --- a/external/io_netcdfpar/wrf_io.F90 +++ b/external/io_netcdfpar/wrf_io.F90 @@ -767,7 +767,7 @@ subroutine Transpose(IO,MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 & call LowerCase(MemoryOrder,MemOrd) select case (MemOrd) - +! Cannot use following define due to gfortran cpp traditional mode concatenation limitations !#define XDEX(A,B,C) A-A ## 1+1+(A ## 2-A ## 1+1)*((B-B ## 1)+(C-C ## 1)*(B ## 2-B ## 1+1)) ! define(`XDEX',($1-``$1''1+1+(``$1''2-``$1''1+1)*(($2-``$2''1)+($3-``$3''1)*(``$2''2-``$2''1+1)))) @@ -953,7 +953,7 @@ subroutine TransposeToR4a(IO,MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 & call LowerCase(MemoryOrder,MemOrd) select case (MemOrd) - +! Cannot use following define due to gfortran cpp traditional mode concatenation limitations !#define XDEX(A,B,C) A-A ## 1+1+(A ## 2-A ## 1+1)*((B-B ## 1)+(C-C ## 1)*(B ## 2-B ## 1+1)) ! define(`XDEX',($1-``$1''1+1+(``$1''2-``$1''1+1)*(($2-``$2''1)+($3-``$3''1)*(``$2''2-``$2''1+1)))) diff --git a/external/io_pnetcdf/wrf_io.F90 b/external/io_pnetcdf/wrf_io.F90 index 18f6ac078a..9d9c3733b4 100644 --- a/external/io_pnetcdf/wrf_io.F90 +++ b/external/io_pnetcdf/wrf_io.F90 @@ -740,7 +740,7 @@ subroutine Transpose(IO,MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 & call LowerCase(MemoryOrder,MemOrd) select case (MemOrd) - +! Cannot use following define due to gfortran cpp traditional mode concatenation limitations !#define XDEX(A,B,C) A-A ## 1+1+(A ## 2-A ## 1+1)*((B-B ## 1)+(C-C ## 1)*(B ## 2-B ## 1+1)) ! define(`XDEX',($1-``$1''1+1+(``$1''2-``$1''1+1)*(($2-``$2''1)+($3-``$3''1)*(``$2''2-``$2''1+1)))) From fc27eaf429903262ac8bb9f7b6c1f5f75a3ebafb Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Wed, 12 Jul 2023 16:06:53 -0600 Subject: [PATCH 18/41] Stub modules to allow for double precision compilation in cmake --- phys/module_mp_SBM_polar_radar.F | 5 +++++ phys/module_mp_fast_sbm.F | 14 ++++++++++++++ 2 files changed, 19 insertions(+) diff --git a/phys/module_mp_SBM_polar_radar.F b/phys/module_mp_SBM_polar_radar.F index 4f94129271..a6ba4e4cc1 100644 --- a/phys/module_mp_SBM_polar_radar.F +++ b/phys/module_mp_SBM_polar_radar.F @@ -6,6 +6,11 @@ SUBROUTINE SBM_polar_radar dummy = 1 END SUBROUTINE SBM_polar_radar END MODULE module_mp_SBM_polar_radar + +! Stub module +module scatt_tables +end module scatt_tables + #else !****************** module scatt_tables diff --git a/phys/module_mp_fast_sbm.F b/phys/module_mp_fast_sbm.F index 184a9220ea..757f05db8c 100644 --- a/phys/module_mp_fast_sbm.F +++ b/phys/module_mp_fast_sbm.F @@ -6,6 +6,20 @@ SUBROUTINE SBM_fast dummy = 1 END SUBROUTINE SBM_fast END MODULE module_mp_fast_sbm + +! Stub modules +module module_mp_SBM_BreakUp +end module module_mp_SBM_BreakUp + +module module_mp_SBM_Collision +end module module_mp_SBM_Collision + +module module_mp_SBM_Auxiliary +end module module_mp_SBM_Auxiliary + +module module_mp_SBM_Nucleation +end module module_mp_SBM_Nucleation + #else ! +-----------------------------------------------------------------------------+ ! +-----------------------------------------------------------------------------+ From 2e6204a722f2dd472c3158f53ac906c7300cab46 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Wed, 10 May 2023 11:45:19 -0600 Subject: [PATCH 19/41] I believe this was a bug, no idea how it was even working before --- external/io_grib2/g2lib/dec_png.c | 2 +- external/io_grib2/g2lib/enc_png.c | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/external/io_grib2/g2lib/dec_png.c b/external/io_grib2/g2lib/dec_png.c index aa85184b36..a33c0c0ac6 100644 --- a/external/io_grib2/g2lib/dec_png.c +++ b/external/io_grib2/g2lib/dec_png.c @@ -88,7 +88,7 @@ int DEC_PNG(unsigned char *pngbuf,g2int *width,g2int *height,char *cout) /* Set new custom read function */ - png_set_read_fn(png_ptr,(voidp)&read_io_ptr,(png_rw_ptr)user_read_data); + png_set_read_fn(png_ptr,(png_voidp)&read_io_ptr,(png_rw_ptr)user_read_data); /* png_init_io(png_ptr, fptr); */ /* Read and decode PNG stream */ diff --git a/external/io_grib2/g2lib/enc_png.c b/external/io_grib2/g2lib/enc_png.c index 7d2ef1d287..97d0b961a9 100644 --- a/external/io_grib2/g2lib/enc_png.c +++ b/external/io_grib2/g2lib/enc_png.c @@ -88,7 +88,7 @@ int ENC_PNG(char *data,g2int *width,g2int *height,g2int *nbits,char *pngbuf) /* Set new custom write functions */ - png_set_write_fn(png_ptr,(voidp)&write_io_ptr,(png_rw_ptr)user_write_data, + png_set_write_fn(png_ptr,(png_voidp)&write_io_ptr,(png_rw_ptr)user_write_data, (png_flush_ptr)user_flush_data); /* png_init_io(png_ptr, fptr); */ /* png_set_compression_level(png_ptr, Z_BEST_COMPRESSION); */ From 7e7a750f0054f45489b3362d8f054ea6acff4730 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Sat, 6 Jan 2024 00:07:45 +0000 Subject: [PATCH 20/41] Re-order ignores categorically --- .gitignore | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/.gitignore b/.gitignore index 26a74951f6..4ca29799af 100644 --- a/.gitignore +++ b/.gitignore @@ -17,17 +17,22 @@ configure.wrf* *.backup *.f90 -_build/ -# New (and old) things we should ignore + +# Out-of-source build locations +_build* wrf_config.cmake -*.nc -rsl.out.* -rsl.error.* + +# Executables when not featuring .exe suffix ndown real tc ideal wrf + +# Model inputs/outputs wrfbdy_d* wrfinput_d* -wrfout_d* \ No newline at end of file +wrfout_d* +*.nc +rsl.out.* +rsl.error.* \ No newline at end of file From cb77ee1cfe2e20e80b6f6188551808da1b77c769 Mon Sep 17 00:00:00 2001 From: Anthony Islas <128631809+islas@users.noreply.github.com> Date: Sat, 6 Jan 2024 01:46:34 +0000 Subject: [PATCH 21/41] Adding missing & (#1976) TYPE: bug fix KEYWORDS: syntax SOURCE: internal DESCRIPTION OF CHANGES: Problem: Wrong Fortran syntax most likely being corrected by standard.exe Solution: Fix the syntax error LIST OF MODIFIED FILES: M dyn_em/module_first_rk_step_part1.F RELEASE NOTE: Bug fix for erroneous syntax in dyn_em/module_first_rk_step_part1.F. --- dyn_em/module_first_rk_step_part1.F | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/dyn_em/module_first_rk_step_part1.F b/dyn_em/module_first_rk_step_part1.F index f5eb26734d..157f260be8 100644 --- a/dyn_em/module_first_rk_step_part1.F +++ b/dyn_em/module_first_rk_step_part1.F @@ -925,7 +925,7 @@ SUBROUTINE first_rk_step_part1 ( grid , config_flags & & ,iopt_crop=config_flags%opt_crop, iopt_irr=config_flags%opt_irr & & ,iopt_irrm=config_flags%opt_irrm & & ,iopt_infdv=config_flags%opt_infdv,iopt_tdrn=config_flags%opt_tdrn & - & ,soiltstep=config_flags%soiltstep + & ,soiltstep=config_flags%soiltstep & & , isnowxy=grid%isnowxy , tvxy=grid%tvxy , tgxy=grid%tgxy & & ,canicexy=grid%canicexy ,canliqxy=grid%canliqxy, eahxy=grid%eahxy & & , tahxy=grid%tahxy , cmxy=grid%cmxy , chxy=grid%chxy & From 98ec8048f48726fa1341f1f0f1897513fa6389c0 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Mon, 8 Jan 2024 20:44:45 +0000 Subject: [PATCH 22/41] EOL added --- .gitignore | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitignore b/.gitignore index 4ca29799af..876fb30491 100644 --- a/.gitignore +++ b/.gitignore @@ -35,4 +35,4 @@ wrfinput_d* wrfout_d* *.nc rsl.out.* -rsl.error.* \ No newline at end of file +rsl.error.* From bb13d1c42da0b634bcf6bb99d147858cf7ef3086 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Tue, 9 Jan 2024 18:54:09 +0000 Subject: [PATCH 23/41] Change error message to correct wording --- tools/registry.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/registry.c b/tools/registry.c index 97759b0942..65f2baddbc 100644 --- a/tools/registry.c +++ b/tools/registry.c @@ -19,7 +19,7 @@ #include "sym.h" // Helper macro to actually do return checks -#define NON_ZERO_RETURN( A ) { int result = A; if ( result != 0 ) { printf( "Error in %s, non-zero return expected", #A ); exit(result); } } +#define NON_ZERO_RETURN( A ) { int result = A; if ( result != 0 ) { printf( "Error in %s, zero return expected, received %i\n", #A, result ); exit(result); } } /* SamT: bug fix: main returns int */ int From 4ed6b68b8ff54537928d95a14ca4fdf7ccb977dc Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Tue, 9 Jan 2024 18:55:14 +0000 Subject: [PATCH 24/41] Change macro name to be accurately descriptive --- tools/registry.c | 68 ++++++++++++++++++++++++------------------------ 1 file changed, 34 insertions(+), 34 deletions(-) diff --git a/tools/registry.c b/tools/registry.c index 65f2baddbc..b2dd0a5f6a 100644 --- a/tools/registry.c +++ b/tools/registry.c @@ -19,7 +19,7 @@ #include "sym.h" // Helper macro to actually do return checks -#define NON_ZERO_RETURN( A ) { int result = A; if ( result != 0 ) { printf( "Error in %s, zero return expected, received %i\n", #A, result ); exit(result); } } +#define EXIT_ON_NONZERO( A ) { int result = A; if ( result != 0 ) { printf( "Error in %s, zero return expected, received %i\n", #A, result ); exit(result); } } /* SamT: bug fix: main returns int */ int @@ -135,11 +135,11 @@ main( int argc, char *argv[], char *env[] ) argv++ ; } - NON_ZERO_RETURN( gen_io_boilerplate() ); /* 20091213 jm. Generate the io_boilerplate_temporary.inc file */ + EXIT_ON_NONZERO( gen_io_boilerplate() ); /* 20091213 jm. Generate the io_boilerplate_temporary.inc file */ - NON_ZERO_RETURN( init_parser() ); - NON_ZERO_RETURN( init_type_table() ); - NON_ZERO_RETURN( init_dim_table() ); + EXIT_ON_NONZERO( init_parser() ); + EXIT_ON_NONZERO( init_type_table() ); + EXIT_ON_NONZERO( init_dim_table() ); // // possible IRR diagnostcis? // @@ -233,43 +233,43 @@ main( int argc, char *argv[], char *env[] ) } - NON_ZERO_RETURN( reg_parse(fp_tmp) ); + EXIT_ON_NONZERO( reg_parse(fp_tmp) ); fclose(fp_tmp) ; check_dimspecs(); - NON_ZERO_RETURN( gen_state_struct( "inc" ) ); - NON_ZERO_RETURN( gen_state_subtypes( "inc" ) ); - NON_ZERO_RETURN( gen_alloc( "inc" ) ); + EXIT_ON_NONZERO( gen_state_struct( "inc" ) ); + EXIT_ON_NONZERO( gen_state_subtypes( "inc" ) ); + EXIT_ON_NONZERO( gen_alloc( "inc" ) ); /* gen_alloc_count( "inc" ) ; */ - NON_ZERO_RETURN( gen_dealloc( "inc" ) ) ; - NON_ZERO_RETURN( gen_scalar_indices( "inc" ) ) ; - NON_ZERO_RETURN( gen_module_state_description( "frame" ) ) ; - NON_ZERO_RETURN( gen_actual_args( "inc" ) ) ; - NON_ZERO_RETURN( gen_actual_args_new( "inc" ) ) ; - NON_ZERO_RETURN( gen_dummy_args( "inc" ) ) ; - NON_ZERO_RETURN( gen_dummy_args_new( "inc" ) ) ; - NON_ZERO_RETURN( gen_dummy_decls( "inc" ) ) ; - NON_ZERO_RETURN( gen_dummy_decls_new( "inc" ) ) ; - NON_ZERO_RETURN( gen_i1_decls( "inc" ) ) ; - NON_ZERO_RETURN( gen_namelist_statements("inc") ; ) - NON_ZERO_RETURN( gen_namelist_defines ( "inc", 0 ) ) ; /* without dimension statements */ - NON_ZERO_RETURN( gen_namelist_defines ( "inc", 1 ) ) ; /* with dimension statements */ - NON_ZERO_RETURN( gen_namelist_defaults ( "inc" ) ) ; - NON_ZERO_RETURN( gen_namelist_script ( "inc" ) ) ; - NON_ZERO_RETURN( gen_get_nl_config( "inc" ) ) ; - NON_ZERO_RETURN( gen_config_assigns( "inc" ) ) ; - NON_ZERO_RETURN( gen_config_reads( "inc" ) ) ; - NON_ZERO_RETURN( gen_wrf_io( "inc" ) ) ; - NON_ZERO_RETURN( gen_model_data_ord( "inc" ) ) ; - NON_ZERO_RETURN( gen_nest_interp( "inc" ) ) ; - NON_ZERO_RETURN( gen_nest_v_interp( "inc") ; ) /*KAL added this for vertical interpolation*/ - NON_ZERO_RETURN( gen_scalar_derefs( "inc" ) ) ; - NON_ZERO_RETURN( gen_streams("inc") ; ) + EXIT_ON_NONZERO( gen_dealloc( "inc" ) ) ; + EXIT_ON_NONZERO( gen_scalar_indices( "inc" ) ) ; + EXIT_ON_NONZERO( gen_module_state_description( "frame" ) ) ; + EXIT_ON_NONZERO( gen_actual_args( "inc" ) ) ; + EXIT_ON_NONZERO( gen_actual_args_new( "inc" ) ) ; + EXIT_ON_NONZERO( gen_dummy_args( "inc" ) ) ; + EXIT_ON_NONZERO( gen_dummy_args_new( "inc" ) ) ; + EXIT_ON_NONZERO( gen_dummy_decls( "inc" ) ) ; + EXIT_ON_NONZERO( gen_dummy_decls_new( "inc" ) ) ; + EXIT_ON_NONZERO( gen_i1_decls( "inc" ) ) ; + EXIT_ON_NONZERO( gen_namelist_statements("inc") ; ) + EXIT_ON_NONZERO( gen_namelist_defines ( "inc", 0 ) ) ; /* without dimension statements */ + EXIT_ON_NONZERO( gen_namelist_defines ( "inc", 1 ) ) ; /* with dimension statements */ + EXIT_ON_NONZERO( gen_namelist_defaults ( "inc" ) ) ; + EXIT_ON_NONZERO( gen_namelist_script ( "inc" ) ) ; + EXIT_ON_NONZERO( gen_get_nl_config( "inc" ) ) ; + EXIT_ON_NONZERO( gen_config_assigns( "inc" ) ) ; + EXIT_ON_NONZERO( gen_config_reads( "inc" ) ) ; + EXIT_ON_NONZERO( gen_wrf_io( "inc" ) ) ; + EXIT_ON_NONZERO( gen_model_data_ord( "inc" ) ) ; + EXIT_ON_NONZERO( gen_nest_interp( "inc" ) ) ; + EXIT_ON_NONZERO( gen_nest_v_interp( "inc") ; ) /*KAL added this for vertical interpolation*/ + EXIT_ON_NONZERO( gen_scalar_derefs( "inc" ) ) ; + EXIT_ON_NONZERO( gen_streams("inc") ; ) /* this has to happen after gen_nest_interp, which adds halos to the AST */ - NON_ZERO_RETURN( gen_comms( "inc" ) ); /* this is either package supplied (by copying a */ + EXIT_ON_NONZERO( gen_comms( "inc" ) ); /* this is either package supplied (by copying a */ /* gen_comms.c file into this directory) or a */ /* stubs routine. */ From a9de8d2113e25009556f13ef9badecd962e9017a Mon Sep 17 00:00:00 2001 From: Tao Sun <41139193+mos3r3n@users.noreply.github.com> Date: Tue, 9 Jan 2024 20:11:49 -0700 Subject: [PATCH 25/41] C code fix for WRFDA build with intel oneAPI compiler and a run-time segfault Fortran bugfix (#1972) TYPE: bugfix KEYWORDS: WRFDA, Intel OneAPI, segfault SOURCE: Tao Sun (NCAR) ISSUE: For use when this PR closes an issue. Fixes #1957 LIST OF MODIFIED FILES: list of changed files (use `git diff --name-status master` to get formatted list) M arch/configure.defaults M var/da/da_obs/da_fill_obs_structures.inc M var/external/bufr/preproc.sh M var/external/bufr/stseq.c M var/external/bufr/bufrlib.h TESTS CONDUCTED: 1. Successfully compiled and tested on Derecho with the intel oneAPI compiler. --- var/da/da_obs/da_fill_obs_structures.inc | 71 ++++++++++++++---------- var/external/bufr/bufrlib.h | 2 + var/external/bufr/preproc.sh | 8 +-- var/external/bufr/stseq.c | 7 +-- 4 files changed, 50 insertions(+), 38 deletions(-) diff --git a/var/da/da_obs/da_fill_obs_structures.inc b/var/da/da_obs/da_fill_obs_structures.inc index 860114da80..7050c7a855 100644 --- a/var/da/da_obs/da_fill_obs_structures.inc +++ b/var/da/da_obs/da_fill_obs_structures.inc @@ -16,9 +16,20 @@ subroutine da_fill_obs_structures(iv, ob, uvq_direct) real :: geometric_h, geopotential_h integer :: i,j logical :: outside + logical :: uvq_direct_local if (trace_use) call da_trace_entry("da_fill_obs_structures") + !--------------------------------------------------------------------------- + ! Initialise uvq_direct_local + !--------------------------------------------------------------------------- + + if (.not. present(uvq_direct)) then + uvq_direct_local = .false. + else + uvq_direct_local = uvq_direct + end if + !--------------------------------------------------------------------------- ! Initialise obs error factors (which will be overwritten in use_obs_errfac) !--------------------------------------------------------------------------- @@ -147,8 +158,8 @@ subroutine da_fill_obs_structures(iv, ob, uvq_direct) if ( q_error_options == 1 ) then ! Calculate q error from rh error: - if (.not. present(uvq_direct) .or. (present(uvq_direct) .and. (.not. uvq_direct))) then - rh_error = iv%synop(n)%q%error ! q error is rh at this stage! + if (.not. uvq_direct_local) then + rh_error = iv%synop(n)%q%error ! q error is rh at this stage! ! if((ob % synop(n) % p > iv%ptop) .AND. & ! (ob % synop(n) % t > 100.0) .AND. & @@ -156,12 +167,12 @@ subroutine da_fill_obs_structures(iv, ob, uvq_direct) ! (iv % synop(n) % p % qc >= obs_qc_pointer) .and. & ! (iv % synop(n) % t % qc >= obs_qc_pointer) .and. & ! (iv % synop(n) % q % qc >= obs_qc_pointer)) then - call da_get_q_error(ob % synop(n) % p, & + call da_get_q_error(ob % synop(n) % p, & ob % synop(n) % t, & ob % synop(n) % q, & iv % synop(n) % t % error, & rh_error, iv % synop(n) % q % error) - if (iv%synop(n)% q % error == missing_r) iv%synop(n)% q % qc = missing_data + if (iv%synop(n)% q % error == missing_r) iv%synop(n)% q % qc = missing_data ! end if end if @@ -181,16 +192,16 @@ subroutine da_fill_obs_structures(iv, ob, uvq_direct) ! Calculate q error from rh error: - if (.not. present(uvq_direct) .or. (present(uvq_direct) .and. (.not. uvq_direct))) then - rh_error = iv%metar(n)%q%error ! q error is rh at this stage! - call da_get_q_error(iv % metar(n) % p % inv, & + if (.not. uvq_direct_local) then + rh_error = iv%metar(n)%q%error ! q error is rh at this stage! + call da_get_q_error(iv % metar(n) % p % inv, & ob % metar(n) % t, & ob % metar(n) % q, & iv % metar(n) % t % error, & rh_error, q_error) - iv % metar(n) % q % error = q_error - if (iv%metar(n)% q % error == missing_r) & - iv%metar(n)% q % qc = missing_data + iv % metar(n) % q % error = q_error + if (iv%metar(n)% q % error == missing_r) & + iv%metar(n)% q % qc = missing_data end if end do end if @@ -207,16 +218,16 @@ subroutine da_fill_obs_structures(iv, ob, uvq_direct) ! Calculate q error from rh error: - if (.not. present(uvq_direct) .or. (present(uvq_direct) .and. (.not. uvq_direct))) then - rh_error = iv%ships(n)%q%error ! q error is rh at this stage! - call da_get_q_error(iv % ships(n) % p % inv, & + if (.not. uvq_direct_local) then + rh_error = iv%ships(n)%q%error ! q error is rh at this stage! + call da_get_q_error(iv % ships(n) % p % inv, & ob % ships(n) % t, & ob % ships(n) % q, & iv % ships(n) % t % error, & rh_error, q_error) - iv % ships(n) % q % error = q_error + iv % ships(n) % q % error = q_error - if(iv%ships(n)% q % error == missing_r) iv%ships(n)% q % qc = missing_data + if(iv%ships(n)% q % error == missing_r) iv%ships(n)% q % qc = missing_data end if end do @@ -301,7 +312,7 @@ subroutine da_fill_obs_structures(iv, ob, uvq_direct) ! Calculate q error from rh error: - if (.not. present(uvq_direct) .or. (present(uvq_direct) .and. (.not. uvq_direct))) then + if (.not. uvq_direct_local) then rh_error = iv%sound(n)%q(k)%error ! q error is rh at this stage! call da_get_q_error(iv % sound(n) % p(k), & ob % sound(n) % t(k), & @@ -310,8 +321,8 @@ subroutine da_fill_obs_structures(iv, ob, uvq_direct) rh_error, q_error) iv % sound(n) % q(k) % error = q_error - if (iv%sound(n)% q(k) % error == missing_r) & - iv%sound(n)% q(k) % qc = missing_data + if (iv%sound(n)% q(k) % error == missing_r) & + iv%sound(n)% q(k) % qc = missing_data end if end do end do @@ -327,15 +338,15 @@ subroutine da_fill_obs_structures(iv, ob, uvq_direct) ! Calculate q error from rh error: - if (.not. present(uvq_direct) .or. (present(uvq_direct) .and. (.not. uvq_direct))) then - rh_error = iv%sonde_sfc(n)%q%error ! q error is rh at this stage! - call da_get_q_error(iv % sonde_sfc(n) % p % inv, & + if (.not. uvq_direct_local) then + rh_error = iv%sonde_sfc(n)%q%error ! q error is rh at this stage! + call da_get_q_error(iv % sonde_sfc(n) % p % inv, & ob % sonde_sfc(n) % t, & ob % sonde_sfc(n) % q, & iv % sonde_sfc(n) % t % error, & rh_error, iv % sonde_sfc(n) % q % error) - if (iv%sonde_sfc(n)% q % error == missing_r) & - iv%sonde_sfc(n)% q % qc = missing_data + if (iv%sonde_sfc(n)% q % error == missing_r) & + iv%sonde_sfc(n)% q % qc = missing_data end if end do end if @@ -350,7 +361,7 @@ subroutine da_fill_obs_structures(iv, ob, uvq_direct) ob % airep(n) % t(k) = iv % airep(n) % t(k) % inv ob % airep(n) % q(k) = iv % airep(n) % q(k) % inv - if (.not. present(uvq_direct) .or. (present(uvq_direct) .and. (.not. uvq_direct))) then + if (.not. uvq_direct_local) then rh_error = iv%airep(n)%q(k)%error ! q error is rh at this stage! call da_get_q_error(iv % airep(n) % p(k), & ob % airep(n) % t(k), & @@ -463,16 +474,16 @@ subroutine da_fill_obs_structures(iv, ob, uvq_direct) ! Calculate q error from rh error: - if (.not. present(uvq_direct) .or. (present(uvq_direct) .and. (.not. uvq_direct))) then - rh_error = iv%buoy(n)%q%error ! q error is rh at this stage! - call da_get_q_error(iv % buoy(n) % p % inv, & + if (.not. uvq_direct_local) then + rh_error = iv%buoy(n)%q%error ! q error is rh at this stage! + call da_get_q_error(iv % buoy(n) % p % inv, & ob % buoy(n) % t, & ob % buoy(n) % q, & iv % buoy(n) % t % error, & rh_error, q_error) - iv % buoy(n) % q % error = q_error + iv % buoy(n) % q % error = q_error - if(iv%buoy (n)% q % error == missing_r) iv%buoy (n)% q % qc = missing_data + if(iv%buoy (n)% q % error == missing_r) iv%buoy (n)% q % qc = missing_data end if end do end if @@ -555,7 +566,7 @@ subroutine da_fill_obs_structures(iv, ob, uvq_direct) ! Calculate q error from rh error: - if (.not. present(uvq_direct) .or. (present(uvq_direct) .and. (.not. uvq_direct))) then + if (.not. uvq_direct_local) then rh_error = iv%airsr(n)%q(k)%error ! q error is rh at this stage! call da_get_q_error(iv % airsr(n) % p(k), & ob % airsr(n) % t(k), & diff --git a/var/external/bufr/bufrlib.h b/var/external/bufr/bufrlib.h index d19fc65a28..7473c1b7bf 100644 --- a/var/external/bufr/bufrlib.h +++ b/var/external/bufr/bufrlib.h @@ -94,6 +94,7 @@ void cwbmg( char *, f77int *, f77int * ); void elemdx( char *, f77int *, f77int ); void gets1loc( char *, f77int *, f77int *, f77int *, f77int *, f77int ); f77int ichkstr ( char *, char *, f77int *, f77int, f77int ); +f77int icvidx( f77int *, f77int *, f77int * ); f77int ifxy( char *, f77int ); f77int igetntbi( f77int *, char *, f77int ); f77int igettdi( f77int * ); @@ -108,6 +109,7 @@ void numtbd( f77int *, f77int *, char *, char *, f77int *, f77int, f77int ); void pktdd( f77int *, f77int *, f77int *, f77int * ); f77int rbytes( char *, f77int *, f77int, f77int ); void restd( f77int *, f77int *, f77int *, f77int * ); +void stntbi( f77int *, f77int *, char *, char *, char * ); void strnum( char *, f77int *, f77int ); void stseq( f77int *, f77int *, f77int *, char *, char *, f77int *, f77int * ); void uptdd( f77int *, f77int *, f77int *, f77int * ); diff --git a/var/external/bufr/preproc.sh b/var/external/bufr/preproc.sh index 42564243ad..bc5ac7d587 100755 --- a/var/external/bufr/preproc.sh +++ b/var/external/bufr/preproc.sh @@ -15,14 +15,14 @@ cat > endiantest.c << ENDIANTEST } \ printf("\n"); -void fill(p, size) char *p; int size; { +void fill(char *p, int size) { char *ab= "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; int i; for (i=0; i Date: Wed, 10 Jan 2024 18:16:46 -0700 Subject: [PATCH 26/41] Enable WRFDA's compilation with RTTOV and HDF5 libs on Derecho TYPE: maintenance KEYWORDS: HDF5, RTTOV, WRFDA SOURCE: internal DESCRIPTION OF CHANGES: Problem: HDF5 lib on derecho is changed, which makes WRFDA compilation failed when including RTTOV lib with HDF5. By default, HDF5 and RTTOV libs are turned off when building WRFDA. Solution: Change an existing HDF5 lib name and add additional HDF5 libs. For gcc: setenv HDF5 /glade/u/apps/derecho/23.06/spack/opt/spack/hdf5/1.12.2/cray-mpich/8.1.25/gcc/12.2.0/wjdl setenv RTTOV /glade/work/liuz/RTTOVv12.1/hdf5/gnu_12.2.0 before configure/compile WRFDA. LIST OF MODIFIED FILES: M compile TESTS CONDUCTED: 1. Build successfully with gnu on Derecho RELEASE NOTE: None --- compile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compile b/compile index 0595d05db1..71624ba466 100755 --- a/compile +++ b/compile @@ -351,7 +351,7 @@ else setenv BUFR 1 endif if ( -e ${RTTOV}/lib/librttov12_main.a ) then - setenv RTTOV_LIB "-L${hdf5path}/lib -lhdf5hl_fortran -lhdf5_hl -lhdf5_fortran -lhdf5 -L${RTTOV}/lib -lrttov12_coef_io -lrttov12_emis_atlas -lrttov12_main -lrttov12_hdf" + setenv RTTOV_LIB "-L${hdf5path}/lib -lhdf5_hl_fortran -lhdf5_hl -lhdf5_fortran -lhdf5 -lhdf5_hl_f90cstub -lhdf5_f90cstub -lhdf5_hl_cpp -L${RTTOV}/lib -lrttov12_coef_io -lrttov12_emis_atlas -lrttov12_main -lrttov12_hdf" else echo "Can not find a compatible RTTOV library! Please ensure that your RTTOV build was successful," echo "your 'RTTOV' environment variable is set correctly, and you are using a supported version of RTTOV." From 484cba66b3f48ed28c2bd5db2b199f05c6a1a824 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Thu, 11 Jan 2024 16:09:41 -0700 Subject: [PATCH 27/41] Output boiler plate back under Registry, but add ./Registry as alternate search path --- tools/gen_streams.c | 4 +--- tools/reg_parse.c | 16 +++++++++------- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/tools/gen_streams.c b/tools/gen_streams.c index e6cbda002d..f93cf3989d 100644 --- a/tools/gen_streams.c +++ b/tools/gen_streams.c @@ -607,14 +607,12 @@ gen_med_find_esmf_coupling ( FILE *fp ) for each stream. This file is then included by the registry.io_boilerplate file when the registry actually runs. As with the other mods above, this allows a variable, compile-time number of io streams. Note that this one is self contained and dirname is hard-coded. - AI: In an effort to delineate true source files from autogen stuff this is now not going into hard-coded - Registry so that we can use ./ as an alternate include location */ int gen_io_boilerplate () { FILE * fp ; - char * dirname = "./" ; + char * dirname = "Registry" ; char fname[NAMELEN] ; char * fn ; char * aux , *streamtype , streamno[5] ; diff --git a/tools/reg_parse.c b/tools/reg_parse.c index 5321b58402..4578d7b202 100644 --- a/tools/reg_parse.c +++ b/tools/reg_parse.c @@ -116,19 +116,21 @@ pre_parse( char * dir, FILE * infile, FILE * outfile ) for ( p = inln ; ( *p == ' ' || *p == ' ' ) && *p != '\0' ; p++ ) ; if ( !strncmp( p , "include", 7 ) && ! ( ifdef_stack_ptr >= 0 && ! ifdef_stack[ifdef_stack_ptr] ) ) { FILE *include_fp ; - char include_file_name_dir[128] ; + char include_file_name_local_registry[128] ; char include_file_name[128] ; p += 7 ; for ( ; ( *p == ' ' || *p == ' ' ) && *p != '\0' ; p++ ) ; if ( strlen( p ) > 127 ) { fprintf(stderr,"Registry warning: invalid include file name: %s\n", p ) ; } else { - sprintf( include_file_name, "%s", p ) ; + sprintf( include_file_name_local_registry, "./Registry/%s", p ) ; + sprintf( include_file_name, "%s/%s", dir , p ) ; + + if ( (p=index(include_file_name_local_registry,'\n')) != NULL ) *p = '\0' ; if ( (p=index(include_file_name,'\n')) != NULL ) *p = '\0' ; - sprintf( include_file_name_dir, "%s/%s", dir , include_file_name ) ; - + fprintf(stderr,"opening %s\n",include_file_name) ; - if ( ( ( include_fp = fopen( include_file_name, "r" ) ) != NULL ) || // Use short circuit logic here to try both sequentially - ( ( include_fp = fopen( include_file_name_dir, "r" ) ) != NULL ) ) + if ( ( ( include_fp = fopen( include_file_name_local_registry, "r" ) ) != NULL ) || // Use short circuit logic here to try both sequentially + ( ( include_fp = fopen( include_file_name, "r" ) ) != NULL ) ) { fprintf(stderr,"including %s\n",include_file_name ) ; @@ -137,7 +139,7 @@ pre_parse( char * dir, FILE * infile, FILE * outfile ) fclose( include_fp ) ; } else { - fprintf(stderr,"Registry warning: cannot open %s. Tried %s and %s Ignoring.\n", include_file_name, include_file_name, include_file_name_dir ) ; + fprintf(stderr,"Registry warning: cannot open %s. Tried %s and %s Ignoring.\n", include_file_name, include_file_name, include_file_name_local_registry ) ; } } } From c124dd522322308f7e6dffa9f7d96a472ad1e3d7 Mon Sep 17 00:00:00 2001 From: Kasra Shamsaei <75144521+kasrash@users.noreply.github.com> Date: Thu, 11 Jan 2024 17:21:37 -0800 Subject: [PATCH 28/41] Adding SB40 fuel model for PR (#1868) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit TYPE: new feature KEYWORDS: WRF-Fire, Fuel, Scott and Burgan, Fuel Model SOURCE: Kasra Shamsaei (University of Nevada, Reno), Tim Juliano, Domingo Munoz-Esparza, Branko Kosovic (NCAR/RAL) DESCRIPTION OF CHANGES: Current version of WRF-Fire has Anderson'13 fuel models which is for 1982. In this PR, we have added the more recent and improved Scott and Burgan 40 fuel models in addition to the current Anderson's fuel model. LIST OF MODIFIED FILES: M phys/module_fr_fire_phys.F A test/em_fire/namelist.fire.sb40 A test/em_fire/namelist.fire_fmc.sb40 TESTS CONDUCTED: 1. These modifications are used in historic fires simulations. 2. It passes the regression tests. RELEASE NOTE: Added Scott and Burgan (2005) 40 fuel models for WRF-Fire (Ref: - Shamsaei, K., Juliano, T. W., Roberts, M., Ebrahimian, H., Kosovic, B., Lareau, N. P., & Taciroglu, E. (2023). Coupled fire-atmosphere simulation of the 2018 Camp Fire using WRF-Fire. International Journal of Wildland Fire. DeCastro, A. L., Juliano, T. W., Kosović, B., Ebrahimian, H., & Balch, J. K. (2022). A Computationally Efficient Method for Updating Fuel Inputs for Wildfire Behavior Models Using Sentinel Imagery and Random Forest Classification. Remote Sensing, 14(6), 1447). --- phys/module_fr_fire_phys.F | 303 ++++++++++++++++++++-------- test/em_fire/namelist.fire.sb40 | 131 ++++++++++++ test/em_fire/namelist.fire_fmc.sb40 | 191 ++++++++++++++++++ 3 files changed, 537 insertions(+), 88 deletions(-) create mode 100644 test/em_fire/namelist.fire.sb40 create mode 100644 test/em_fire/namelist.fire_fmc.sb40 diff --git a/phys/module_fr_fire_phys.F b/phys/module_fr_fire_phys.F index 3f8708031e..7e9c4a49c8 100644 --- a/phys/module_fr_fire_phys.F +++ b/phys/module_fr_fire_phys.F @@ -58,7 +58,7 @@ module module_fr_fire_phys ! 4. add default !*** dimensions - INTEGER, PARAMETER :: mfuelcats = 30 ! allowable number of fuel categories + INTEGER, PARAMETER :: mfuelcats = 60 ! allowable number of fuel categories INTEGER, PARAMETER ::max_moisture_classes=5 !*** @@ -148,7 +148,7 @@ module module_fr_fire_phys ! FUEL MODEL 14: no fuel ! scalar fuel coefficients - REAL, SAVE:: cmbcnst,hfgl,fuelmc_g,fuelmc_c + REAL, SAVE:: cmbcnst,hfgl,fuelmc_g,fuelmc_g_lh,fuelmc_c ! computed values REAL, SAVE:: fuelheat @@ -156,6 +156,7 @@ module module_fr_fire_phys DATA cmbcnst / 17.433e+06/ ! J/kg dry fuel DATA hfgl / 17.e4 / ! W/m^2 DATA fuelmc_g / 0.08 / ! set = 0 for dry surface fuel + DATA fuelmc_g_lh / 1.20 / ! set >= 1.20 for uncured live herb fuels; <=0.30 for fully cured live herb fuels DATA fuelmc_c / 1.00 / ! set = 0 for dry canopy ! REAL, PARAMETER :: bmst = fuelmc_g/(1+fuelmc_g) ! REAL, PARAMETER :: fuelheat = cmbcnst * 4.30e-04 ! convert J/kg to BTU/lb @@ -164,9 +165,11 @@ module module_fr_fire_phys ! fuel categorytables - INTEGER, PARAMETER :: nf=14 ! number of fuel categories in data stmts - INTEGER, SAVE :: nfuelcats = 13 ! number of fuel categories that are specified - INTEGER, PARAMETER :: zf = mfuelcats-nf ! number of zero fillers in data stmt + INTEGER, PARAMETER :: nf0=14 ! number of fuel categories in old Anderson fuel model + INTEGER, PARAMETER :: nf=54 ! number of fuel categories in data stmts + INTEGER, SAVE :: nfuelcats = 53 ! number of fuel categories that are specified + INTEGER, PARAMETER :: zf = mfuelcats-nf ! number of zero fillers in data stmt + INTEGER, PARAMETER :: zf0 = mfuelcats-nf0 ! number of zero fillers in old parameters originally defined for Anderson fuel model INTEGER, SAVE :: no_fuel_cat = 14 ! special category outside of 1:nfuelcats CHARACTER (len=80), DIMENSION(mfuelcats ), save :: fuel_name INTEGER, DIMENSION( mfuelcats ), save :: ichap @@ -174,7 +177,8 @@ module module_fr_fire_phys fueldepthm,fueldens,fuelmce, & savr,st,se, & fgi_1h,fgi_10h,fgi_100h,fgi_1000h,fgi_live, & - fgi_t,fmc_gwt + fgi_t,fmc_gwt, & + fgi_lh REAL, DIMENSION(mfuelcats,max_moisture_classes), save :: fgi_c, fmc_gw ! fuel moisture class weights DATA fuel_name /'1: Short grass (1 ft)', & '2: Timber (grass and understory)', & @@ -189,42 +193,158 @@ module module_fr_fire_phys '11: Light logging slash', & '12: Medium logging slash', & '13: Heavy logging slash', & - '14: no fuel', zf* ' '/ + '14: no fuel', & + '15: Short, Sparse Dry Climate Grass (Dynamic) [GR1 (101)]', & + '16: Low Load, Dry Climate Grass (Dynamic) GR2 (102)', & + '17: Low Load, Very Coarse, Humid Climate Grass (Dynamic) [GR3 (103)]', & + '18: Moderate Load, Dry Climate Grass (Dynamic) [GR4 (104)]', & + '19: Low Load, Humid Climate Grass (Dynamic) [GR5 (105)]', & + '20: Moderate Load, Humid Climate Grass (Dynamic) [GR6 (106)]', & + '21: High Load, Dry Climate Grass (Dynamic) [GR7 (107)]', & + '22: High Load, Very Coarse, Humid Climate Grass (Dynamic) [GR8 (108)]', & + '23: Very High Load, Humid Climate Grass (Dynamic) [GR9 (109)]', & + '24: Low Load, Dry Climate Grass-Shrub (Dynamic) [GS1 (121)]', & + '25: Moderate Load, Dry Climate Grass-Shrub (Dynamic) [GS2 (122)]', & + '26: Moderate Load, Humid Climate Grass-Shrub (Dynamic) [GS3 (123)]', & + '27: High Load, Humid Climate Grass-Shrub (Dynamic) [GS4 (124)]', & + '28: Low Load Dry Climate Shrub (Dynamic) [SH1 (141)]', & + '29: Moderate Load Dry Climate Shrub [SH2 (142)]', & + '30: Moderate Load, Humid Climate Shrub [SH3 (143)]', & + '31: Low Load, Humid Climate Timber-Shrub [SH4 (144)]', & + '32: High Load, Dry Climate Shrub [SH5 (145)]', & + '33: Low Load, Humid Climate Shrub [SH6 (146)]', & + '34: Very High Load, Dry Climate Shrub [SH7 (147)]', & + '35: High Load, Humid Climate Shrub [SH8 (148)]', & + '36: Very High Load, Humid Climate Shrub (Dynamic) [SH9 (149)]', & + '37: Low Load Dry Climate Timber-Grass-Shrub (Dynamic) [TU1 (161)]', & + '38: Moderate Load, Humid Climate Timber-Shrub [TU2 (162)]', & + '39: Moderate Load, Humid Climate Timber-Grass-Shrub (Dynamic) [TU3 (163)]', & + '40: Dwarf Conifer With Understory [TU4 (164)]', & + '41: Very High Load, Dry Climate Timber-Shrub [TU5 (165)]', & + '42: Low Load Compact Conifer Litter [TL1 (181)]', & + '43: Low Load Broadleaf Litter [TL2 (182)]', & + '44: Moderate Load Conifer Litter [TL3 (183)]', & + '45: Small downed logs [TL4 (184)]', & + '46: High Load Conifer Litter [TL5 (185)]', & + '47: Moderate Load Broadleaf Litter [TL6 (186)]', & + '48: Large Downed Logs [TL7 (187)]', & + '49: Long-Needle Litter [TL8 (188)]', & + '50: Very High Load Broadleaf Litter [TL9 (189)]', & + '51: Low Load Activity Fuel [SB1 (201)]', & + '52: Moderate Load Activity Fuel or Low Load Blowdown [SB2 (202)]', & + '53: High Load Activity Fuel or Moderate Load Blowdown [SB3 (203)]', & + '54: High Load Blowdown [SB4 (204)]', zf* ' '/ DATA windrf /0.36, 0.36, 0.44, 0.55, 0.42, 0.44, 0.44, & - 0.36, 0.36, 0.36, 0.36, 0.43, 0.46, 1e-7, zf*0 / - DATA fueldepthm /0.305, 0.305, 0.762, 1.829, 0.61, 0.762,0.762, & - 0.0610, 0.0610, 0.305, 0.305, 0.701, 0.914, 0.305,zf*0. / - DATA savr / 3500., 2784., 1500., 1739., 1683., 1564., 1562., & - 1889., 2484., 1764., 1182., 1145., 1159., 3500., zf*0. / - DATA fuelmce / 0.12, 0.15, 0.25, 0.20, 0.20, 0.25, 0.40, & - 0.30, 0.25, 0.25, 0.15, 0.20, 0.25, 0.12 , zf*0. / + 0.36, 0.36, 0.36, 0.36, 0.43, 0.46, 1e-7, zf0*0 / + DATA fueldepthm /0.305, 0.305, 0.762, 1.829, 0.61, 0.762,0.762, 0.0610, 0.0610, 0.305, 0.305, 0.701, 0.914, 0.305, & ! Anderson 13 + no fuel + 0.1219, 0.3048, 0.6096, 0.6096, 0.4572, 0.4572, 0.9144, 1.2192, 1.5240, & ! Scott & Burgan: GR fuels (1-9) + 0.2743, 0.4572, 0.5486, 0.6401, & ! Scott & Burgan: GS fuels (1-4) + 0.3048, 0.3048, 0.7315, 0.9144, 1.8288, 0.6096, 1.8288, 0.9144, 1.3411, & ! Scott & Burgan: SH fuels (1-9) + 0.1829, 0.3048, 0.3962, 0.1524, 0.3048, & ! Scott & Burgan: TU fuels (1-5) + 0.0610, 0.0610, 0.0914, 0.1219, 0.1829, 0.0914, 0.1219, 0.0914, 0.1829, & ! Scott & Burgan: TL fuels (1-9) + 0.3048, 0.3048, 0.3658, 0.8230, & ! Scott & Burgan: SB fuels (1-4) + zf*0. / + DATA savr / 3500., 2784., 1500., 1739., 1683., 1564., 1562., 1889., 2484., 1764., 1182., 1145., 1159., 3500., & ! Anderson 13 + no fuel + 2200., 2000., 1500., 2000., 1800., 2200., 2000., 1500., 1800., & ! Scott & Burgan: GR fuels (1-9) + 2000., 2000., 1800., 1800., & ! Scott & Burgan: GS fuels (1-4) + 2000., 2000., 1600., 2000., 750., 750., 750., 750., 750., & ! Scott & Burgan: SH fuels (1-9) + 2000., 2000., 1800., 2300., 1500., & ! Scott & Burgan: TU fuels (1-5) + 2000., 2000., 2000., 2000., 2000., 2000., 2000., 1800., 1800., & ! Scott & Burgan: TL fuels (1-9) + 2000., 2000., 2000., 2000., & ! Scott & Burgan: SB fuels (1-4) + zf*0. / + DATA fuelmce / 0.12, 0.15, 0.25, 0.20, 0.20, 0.25, 0.40, 0.30, 0.25, 0.25, 0.15, 0.20, 0.25, 0.12, & ! Anderson 13 + no fuel + 0.15, 0.15, 0.30, 0.15, 0.40, 0.40, 0.15, 0.30, 0.40, & ! Scott & Burgan: GR fuels (1-9) + 0.15, 0.15, 0.40, 0.40, & ! Scott & Burgan: GS fuels (1-4) + 0.15, 0.15, 0.40, 0.30, 0.15, 0.30, 0.15, 0.40, 0.40, & ! Scott & Burgan: SH fuels (1-9) + 0.20, 0.30, 0.30, 0.12, 0.25, & ! Scott & Burgan: TU fuels (1-5) + 0.30, 0.25, 0.20, 0.25, 0.25, 0.25, 0.25, 0.35, 0.35, & ! Scott & Burgan: TL fuels (1-9) + 0.25, 0.25, 0.25, 0.25, & ! Scott & Burgan: SB fuels (1-4) + zf*0. / DATA fueldens / nf * 32., zf*0. / ! 32 if solid, 19 if rotten. DATA st / nf* 0.0555 , zf*0./ DATA se / nf* 0.010 , zf*0./ ! ----- Notes on weight: (4) - best fit of data from D. Latham (pers. comm.); ! (5)-(7) could be 60-120; (8)-(10) could be 300-1600; ! (11)-(13) could be 300-1600 - DATA weight / 7., 7., 7., 180., 100., 100., 100., & - 900., 900., 900., 900., 900., 900., 7. , zf*0./ + DATA weight / 7., 7., 7., 180., 100., 100., 100., 900., 900., 900., 900., 900., 900., 7., & ! Anderson 13 + no fuel + 7., 7., 7., 7., 7., 7., 7., 7., 7., & ! Scott & Burgan: GR fuels (1-9) + 7., 7., 7., 7., & ! Scott & Burgan: GS fuels (1-4) + 100., 100., 100., 100., 180., 100., 180., 100., 100., & ! Scott & Burgan: SH fuels (1-9) + 900., 900., 900., 900., 900., & ! Scott & Burgan: TU fuels (1-5) + 900., 900., 900., 900., 900., 900., 900., 900., 900., & ! Scott & Burgan: TL fuels (1-9) + 900., 900., 900., 900., & ! Scott & Burgan: SB fuels (1-4) + zf*0./ ! ----- 1.12083 is 5 tons/acre. 5-50 tons/acre orig., 100-300 after blowdown DATA fci_d / 0., 0., 0., 1.123, 0., 0., 0., & - 1.121, 1.121, 1.121, 1.121, 1.121, 1.121, 0., zf*0./ + 1.121, 1.121, 1.121, 1.121, 1.121, 1.121, 0., zf0*0./ DATA fct / 60., 60., 60., 60., 60., 60., 60., & - 60., 120., 180., 180., 180., 180. , 60. , zf*0. / - DATA ichap / 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 , zf*0/ + 60., 120., 180., 180., 180., 180. , 60. , zf0*0. / + DATA ichap / 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 , zf0*0/ ! DATA fmc_gw05 / 0.000, 0.023, 0.000, 0.230, 0.092, 0.000, 0.017, 0.000, 0.000, 0.092, 0.000, 0.000, 0.000, zf*0/ ! fuel loading 1-h, 10-h, 100-h, 1000-h, live following Albini 1976 as reprinted in Anderson 1982 Table 1 (for proportions only) ! 1 2 3 4 5 6 7 8 9 10 11 12 13 14 - DATA fgi_1h / 0.74, 2.00, 3.01, 5.01, 1.00, 1.50, 1.13, 1.50, 2.92, 3.01, 1.50, 4.01, 7.01, 0.0, zf*0./ - DATA fgi_10h / 0.00, 1.00, 0.00, 4.01, 0.50, 2.50, 1.87, 1.00, 0.41, 2.00, 4.51, 14.03, 23.04, 0.0, zf*0./ - DATA fgi_100h / 0.00, 0.50, 0.00, 2.00, 0.00, 2.00, 1.50, 2.50, 0.15, 5.01, 5.51, 16.53, 28.05, 0.0, zf*0./ - DATA fgi_1000h / 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, zf*0./ - DATA fgi_live / 0.00, 0.50, 0.000, 5.01, 2.00, 0.00, 0.37, 0.00, 0.00, 2.00, 0.00, 2.3, 0.00, 0.0, zf*0./ - -! total fuel loading kg/m^2 - DATA fgi / 0.166, 0.896, 0.674, 3.591, 0.784, 1.344, 1.091, 1.120, 0.780, 2.692, 2.582, 7.749, 13.024, 1.e-7, zf*0. / + DATA fgi_1h / 0.74, 2.00, 3.01, 5.01, 1.00, 1.50, 1.13, 1.50, 2.92, 3.01, 1.50, 4.01, 7.01, 0.0, & ! Anderson 13 + no fuel + 0.10, 0.10, 0.10, 0.25, 0.40, 0.10, 1.00, 0.50, 1.00, & ! Scott & Burgan: GR fuels (1-9) + 0.20, 0.50, 0.30, 1.90, & ! Scott & Burgan: GS fuels (1-4) + 0.25, 1.35, 0.45, 0.85, 3.60, 2.90, 3.50, 2.05, 4.50, & ! Scott & Burgan: SH fuels (1-9) + 0.20, 0.95, 1.10, 4.50, 4.00, & ! Scott & Burgan: TU fuels (1-5) + 1.00, 1.40, 0.50, 0.50, 1.15, 2.40, 0.30, 5.80, 6.65, & ! Scott & Burgan: TL fuels (1-9) + 1.50, 4.50, 5.50, 5.25, & ! Scott & Burgan: SB fuels (1-4) + zf*0. / + DATA fgi_10h / 0.00, 1.00, 0.00, 4.01, 0.50, 2.50, 1.87, 1.00, 0.41, 2.00, 4.51, 14.03, 23.04, 0.0, & ! Anderson 13 + no fuel + 0.00, 0.00, 0.40, 0.00, 0.00, 0.00, 0.00, 1.00, 1.00, & ! Scott & Burgan: GR fuels (1-9) + 0.00, 0.50, 0.25, 0.30, & ! Scott & Burgan: GS fuels (1-4) + 0.25, 2.40, 3.00, 1.15, 2.10, 1.45, 5.30, 3.40, 2.45, & ! Scott & Burgan: SH fuels (1-9) + 0.90, 1.80, 0.15, 0.00, 4.00, & ! Scott & Burgan: TU fuels (1-5) + 2.20, 2.30, 2.20, 1.50, 2.50, 1.20, 1.40, 1.40, 3.30, & ! Scott & Burgan: TL fuels (1-9) + 3.00, 4.25, 2.75, 3.50, & ! Scott & Burgan: SB fuels (1-4) + zf*0./ + DATA fgi_100h / 0.00, 0.50, 0.00, 2.00, 0.00, 2.00, 1.50, 2.50, 0.15, 5.01, 5.51, 16.53, 28.05, 0.0, & ! Anderson 13 + no fuel + 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & ! Scott & Burgan: GR fuels (1-9) + 0.00, 0.00, 0.00, 0.10, & ! Scott & Burgan: GS fuels (1-4) + 0.00, 0.75, 0.00, 0.20, 0.00, 0.00, 2.20, 0.85, 0.00, & ! Scott & Burgan: SH fuels (1-9) + 1.50, 1.25, 0.25, 0.00, 3.00, & ! Scott & Burgan: TU fuels (1-5) + 3.60, 2.20, 2.80, 4.20, 4.40, 1.20, 8.10, 1.10, 4.15, & ! Scott & Burgan: TL fuels (1-9) + 11.00, 4.00, 3.00, 5.25, & ! Scott & Burgan: SB fuels (1-4) + zf*0./ + DATA fgi_1000h / 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & ! Anderson 13 + no fuel + 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & ! Scott & Burgan: GR fuels (1-9) + 0.00, 0.00, 0.00, 0.00, & ! Scott & Burgan: GS fuels (1-4) + 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & ! Scott & Burgan: SH fuels (1-9) + 0.00, 0.00, 0.00, 0.00, 0.00, & ! Scott & Burgan: TU fuels (1-5) + 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & ! Scott & Burgan: TL fuels (1-9) + 0.00, 0.00, 0.00, 0.00, & ! Scott & Burgan: SB fuels (1-4) + zf*0./ + DATA fgi_live / 0.00, 0.50, 0.00, 5.01, 2.00, 0.00, 0.37, 0.00, 0.00, 2.00, 0.0, 0.0, 0.0, 0.0, & ! Anderson 13 + no fuel + 0.30, 1.00, 1.50, 1.90, 2.50, 3.40, 5.40, 7.30, 9.00, & ! Scott & Burgan: GR fuels (1-9) + 0.50, 0.60, 1.45, 3.40, & ! Scott & Burgan: GS fuels (1-4) + 0.15, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 1.55, & ! Scott & Burgan: SH fuels (1-9) + 0.20, 0.00, 0.65, 0.00, 0.00, & ! Scott & Burgan: TU fuels (1-5) + 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & ! Scott & Burgan: TL fuels (1-9) + 0.00, 0.00, 0.00, 0.00, & ! Scott & Burgan: SB fuels (1-4) + zf*0./ + +! fuel loading live herb fuels, kg/m^2 + DATA fgi_lh / 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & ! Anderson 13 + no fuel + 0.0673, 0.2242, 0.3363, 0.4259, 0.5604, 0.7622, 1.2105, 1.6364, 2.0175, & ! Scott & Burgan: GR fuels (1-9) + 0.1121, 0.1345, 0.3250, 0.7622, & ! Scott & Burgan: GS fuels (1-4) + 0.0336, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.3475, & ! Scott & Burgan: SH fuels (1-9) + 0.0448, 0.0000, 0.1457, 0.0000, 0.0000, & ! Scott & Burgan: TU fuels (1-5) + 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, & ! Scott & Burgan: TL fuels (1-9) + 0.0000, 0.0000, 0.0000, 0.0000, & ! Scott & Burgan: SB fuels (1-4) + zf*0. / + +! fuel loading 1-h, 10-h, and 100-h dead fuels combined, kg/m^2 + DATA fgi / 0.166, 0.896, 0.674, 3.591, 0.784, 1.344, 1.091, 1.120, 0.780, 2.692, 2.582, 7.749, 13.024, 1.e-7, & ! Anderson 13 + no fuel + 0.0224, 0.0224, 0.1121, 0.0560, 0.0897, 0.0224, 0.2242, 0.3363, 0.4483, & ! Scott & Burgan: GR fuels (1-9) + 0.0448, 0.2242, 0.1233, 0.5156, & ! Scott & Burgan: GS fuels (1-4) + 0.1121, 1.0088, 0.7734, 0.4932, 1.2778, 0.9751, 2.4659, 1.4123, 1.5580, & ! Scott & Burgan: SH fuels (1-9) + 0.5828, 0.8967, 0.3363, 1.0088, 2.4659, & ! Scott & Burgan: TU fuels (1-5) + 1.5244, 1.3226, 1.2329, 1.3899, 1.8046, 1.0760, 2.1969, 1.8606, 3.1608, & ! Scott & Burgan: TL fuels (1-9) + 3.4746, 2.8582, 2.5219, 3.1384, & ! Scott & Burgan: SB fuels (1-4) + zf*0. / ! ========================================================================= contains @@ -629,8 +749,8 @@ subroutine read_namelist_fire(init_fuel_moisture) !*** executable ! read -namelist /fuel_scalars/ cmbcnst,hfgl,fuelmc_g,fuelmc_c,nfuelcats,no_fuel_cat -namelist /fuel_categories/ fuel_name,windrf,fgi,fueldepthm,savr, & +namelist /fuel_scalars/ cmbcnst,hfgl,fuelmc_g,fuelmc_g_lh,fuelmc_c,nfuelcats,no_fuel_cat +namelist /fuel_categories/ fuel_name,windrf,fgi,fgi_lh,fueldepthm,savr, & fuelmce,fueldens,st,se,weight,fci_d,fct,ichap,fgi_1h,fgi_10h,fgi_100h,fgi_1000h,fgi_live namelist /fuel_moisture/ moisture_classes,drying_lag,wetting_lag,saturation_moisture,saturation_rain,rain_threshold, & drying_model,wetting_model, moisture_class_name,fmc_gc_initialization, fmc_1h,fmc_10h,fmc_100h,fmc_1000h,fmc_live @@ -684,7 +804,7 @@ subroutine read_namelist_fire(init_fuel_moisture) write(msg,*)'nfuelcats=',nfuelcats,' is too large, increase mfuelcats' call crash(msg) endif - if (no_fuel_cat >= 1 .and. no_fuel_cat <= nfuelcats)then + if (nfuelcats<14 .and. no_fuel_cat >= 1 .and. no_fuel_cat <= nfuelcats)then write(msg,*)'no_fuel_cat=',no_fuel_cat,' may not be between 1 and nfuelcats=',nfuelcats call crash(msg) endif @@ -782,6 +902,7 @@ subroutine init_fuel_cats(init_fuel_moisture) call wrf_dm_bcast_real(cmbcnst,1) call wrf_dm_bcast_real(hfgl,1) call wrf_dm_bcast_real(fuelmc_g,1) +call wrf_dm_bcast_real(fuelmc_g_lh,1) call wrf_dm_bcast_real(fuelmc_c,1) call wrf_dm_bcast_integer(nfuelcats,1) call wrf_dm_bcast_integer(no_fuel_cat,1) @@ -841,6 +962,8 @@ subroutine init_fuel_cats(init_fuel_moisture) call message(msg) write(msg,8)'fuelmc_g ',fuelmc_g call message(msg) +write(msg,8)'fuelmc_g_lh ',fuelmc_g_lh +call message(msg) write(msg,8)'fuelmc_c ',fuelmc_c call message(msg) write(msg,8)'fuelheat ',fuelheat @@ -940,7 +1063,7 @@ subroutine init_fuel_cats(init_fuel_moisture) ! and print to file IF ( wrf_dm_on_monitor() ) THEN -!jm call write_fuels_m(61,30.,1.) + call write_fuels_m(61,30.,1.) ENDIF end subroutine init_fuel_cats @@ -984,7 +1107,8 @@ subroutine write_fuels_m(nsteps,maxwind,maxslope) do k=1,nfuelcats write(iounit,10)k,'fuel_name',trim(fuel_name(k)),'FUEL MODEL NAME' call write_var(k,'windrf',windrf(k),'WIND REDUCTION FACTOR FROM 20ft TO MIDFLAME HEIGHT' ) - call write_var(k,'fgi',fgi(k),'INITIAL TOTAL MASS OF SURFACE FUEL (KG/M**2)' ) + call write_var(k,'fgi',fgi(k),'INITIAL TOTAL MASS OF SURFACE DEAD FUEL (KG/M**2)' ) + call write_var(k,'fgi_lh',fgi_lh(k),'INITIAL TOTAL MASS OF SURFACE LIVE HERB FUEL [SB: 1-h] (KG/M**2)' ) call write_var(k,'fueldepthm',fueldepthm(k),'FUEL DEPTH (M)') call write_var(k,'savr',savr(k),'FUEL PARTICLE SURFACE-AREA-TO-VOLUME RATIO, 1/FT') call write_var(k,'fuelmce',fuelmce(k),'MOISTURE CONTENT OF EXTINCTION') @@ -1128,60 +1252,53 @@ subroutine set_fire_params( & ksb(11)=11 ksb(12)=12 ksb(13)=13 -! Scott & Burgan crosswalks -! Short grass -- 1 -ksb(101)=1 -ksb(104)=1 -ksb(107)=1 -! Timber grass and understory -- 2 -ksb(102)=2 -ksb(121)=2 -ksb(122)=2 -ksb(123)=2 -ksb(124)=2 -! Tall grass -- 3 -ksb(103)=3 -ksb(105)=3 -ksb(106)=3 -ksb(108)=3 -ksb(109)=3 -! Chaparral -- 4 -ksb(145)=4 -ksb(147)=4 -! Brush -- 5 -ksb(142)=5 -! Dormant Brushi -- 6 -ksb(141)=6 -ksb(146)=6 -! Southern Rough -- 7 -ksb(143)=7 -ksb(144)=7 -ksb(148)=7 -ksb(149)=7 -! Compact Timber Litter -- 8 -ksb(181)=8 -ksb(183)=8 -ksb(184)=8 -ksb(187)=8 -! Hardwood Litter -- 9 -ksb(182)=9 -ksb(186)=9 -ksb(188)=9 -ksb(189)=9 -! Timber (understory) -- 10 -ksb(161)=10 -ksb(162)=10 -ksb(163)=10 -ksb(164)=10 -ksb(165)=10 -! Light Logging Slash -- 11 -ksb(185)=11 -ksb(201)=11 -! Medium Logging Slash -- 12 -ksb(202)=12 -! Heavy Logging Slash -- 13 -ksb(203)=13 -ksb(204)=13 +! full Scott and Burgan (2005) +! Grass (GR) +ksb(101)=15 +ksb(102)=16 +ksb(103)=17 +ksb(104)=18 +ksb(105)=19 +ksb(106)=20 +ksb(107)=21 +ksb(108)=22 +ksb(109)=23 +! Grass-Shrub (GS) +ksb(121)=24 +ksb(122)=25 +ksb(123)=26 +ksb(124)=27 +! Shrub (SH) +ksb(141)=28 +ksb(142)=29 +ksb(143)=30 +ksb(144)=31 +ksb(145)=32 +ksb(146)=33 +ksb(147)=34 +ksb(148)=35 +ksb(149)=36 +! Timber-Understory (TU) +ksb(161)=37 +ksb(162)=38 +ksb(163)=39 +ksb(164)=40 +ksb(165)=41 +! Timber litter (TL) +ksb(181)=42 +ksb(182)=43 +ksb(183)=44 +ksb(184)=45 +ksb(185)=46 +ksb(186)=47 +ksb(187)=48 +ksb(188)=49 +ksb(189)=50 +! Slash-Blowdown (SB) +ksb(201)=51 +ksb(202)=52 +ksb(203)=53 +ksb(204)=54 ! ****** ! @@ -1221,7 +1338,17 @@ subroutine set_fire_params( & ! exp(-600*0.85/1000) = approx 0.6 fp%ischap(i,j)=ichap(k) - fp%fgip(i,j)=fgi(k) + + ! DME dynamic live to dead fuel conversion and fuel load selection (start) + ! Use sum 1-h, 10-h, 100-h dead fuel loads for S&B classes + if ( fuelmc_g_lh .gt. 0.3 .AND. fuelmc_g_lh .lt. 1.2 ) then + fp%fgip(i,j)=fgi(k)+(1.0-(fuelmc_g_lh-0.3)/0.9)*fgi_lh(k) + elseif ( fuelmc_g_lh .le. 0.3 ) then + fp%fgip(i,j)=fgi(k)+fgi_lh(k) + else + fp%fgip(i,j)=fgi(k) + endif + if(fire_fmc_read.eq.1)then fp%fmc_g(i,j)=fuelmc_g endif @@ -1230,7 +1357,7 @@ subroutine set_fire_params( & ! don't need to be recalculated later. bmst = fp%fmc_g(i,j) / (1.+fp%fmc_g(i,j)) - fuelloadm= (1.-bmst) * fgi(k) ! fuelload without moisture + fuelloadm= (1.-bmst) * fp%fgip(i,j) ! fuelload without moisture fuelload = fuelloadm * (.3048)**2 * 2.205 ! to lb/ft^2 fueldepth = fueldepthm(k)/0.3048 ! to ft fp%betafl(i,j) = fuelload/(fueldepth * fueldens(k))! packing ratio diff --git a/test/em_fire/namelist.fire.sb40 b/test/em_fire/namelist.fire.sb40 new file mode 100644 index 0000000000..c80b11b1ec --- /dev/null +++ b/test/em_fire/namelist.fire.sb40 @@ -0,0 +1,131 @@ +&fuel_scalars ! scalar fuel constants +cmbcnst = 17.433e+06, ! J/kg combustion heat dry fuel +hfgl = 17.e4 , ! W/m^2 heat flux to ignite canopy +fuelmc_g = 0.08, ! ground fuel moisture, set = 0 for dry +fuelmc_g_lh = 1.20, ! ground live herb fuel moisture, set = 0 for dry +fuelmc_c = 1.00, ! canopy fuel moisture, set = 0 for dry +nfuelcats = 54, ! number of fuel categories used +no_fuel_cat = 14 ! extra category for no fuel +/ + +&fuel_categories + fuel_name = +'1: Short grass (1 ft)', +'2: Timber (grass and understory)', +'3: Tall grass (2.5 ft)', +'4: Chaparral (6 ft)', +'5: Brush (2 ft) ', +'6: Dormant brush, hardwood slash', +'7: Southern rough', +'8: Closed timber litter', +'9: Hardwood litter', +'10: Timber (litter + understory)', +'11: Light logging slash', +'12: Medium logging slash', +'13: Heavy logging slash', +'14: no fuel', +'15: Short, Sparse Dry Climate Grass (Dynamic) [GR1 (101)]', +'16: Low Load, Dry Climate Grass (Dynamic) GR2 (102)', +'17: Low Load, Very Coarse, Humid Climate Grass (Dynamic) [GR3 (103)]', +'18: Moderate Load, Dry Climate Grass (Dynamic) [GR4 (104)]', +'19: Low Load, Humid Climate Grass (Dynamic) [GR5 (105)]', +'20: Moderate Load, Humid Climate Grass (Dynamic) [GR6 (106)]', +'21: High Load, Dry Climate Grass (Dynamic) [GR7 (107)]', +'22: High Load, Very Coarse, Humid Climate Grass (Dynamic) [GR8 (108)]', +'23: Very High Load, Humid Climate Grass (Dynamic) [GR9 (109)]', +'24: Low Load, Dry Climate Grass-Shrub (Dynamic) [GS1 (121)]', +'25: Moderate Load, Dry Climate Grass-Shrub (Dynamic) [GS2 (122)]', +'26: Moderate Load, Humid Climate Grass-Shrub (Dynamic) [GS3 (123)]', +'27: High Load, Humid Climate Grass-Shrub (Dynamic) [GS4 (124)]', +'28: Low Load Dry Climate Shrub (Dynamic) [SH1 (141)]', +'29: Moderate Load Dry Climate Shrub [SH2 (142)]', +'30: Moderate Load, Humid Climate Shrub [SH3 (143)]', +'31: Low Load, Humid Climate Timber-Shrub [SH4 (144)]', +'32: High Load, Dry Climate Shrub [SH5 (145)]', +'33: Low Load, Humid Climate Shrub [SH6 (146)]', +'34: Very High Load, Dry Climate Shrub [SH7 (147)]', +'35: High Load, Humid Climate Shrub [SH8 (148)]', +'36: Very High Load, Humid Climate Shrub (Dynamic) [SH9 (149)]', +'37: Low Load Dry Climate Timber-Grass-Shrub (Dynamic) [TU1 (161)]', +'38: Moderate Load, Humid Climate Timber-Shrub [TU2 (162)]', +'39: Moderate Load, Humid Climate Timber-Grass-Shrub (Dynamic) [TU3 (163)]', +'40: Dwarf Conifer With Understory [TU4 (164)]', +'41: Very High Load, Dry Climate Timber-Shrub [TU5 (165)]', +'42: Low Load Compact Conifer Litter [TL1 (181)]', +'43: Low Load Broadleaf Litter [TL2 (182)]', +'44: Moderate Load Conifer Litter [TL3 (183)]', +'45: Small downed logs [TL4 (184)]', +'46: High Load Conifer Litter [TL5 (185)]', +'47: Moderate Load Broadleaf Litter [TL6 (186)]', +'48: Large Downed Logs [TL7 (187)]', +'49: Long-Needle Litter [TL8 (188)]', +'50: Very High Load Broadleaf Litter [TL9 (189)]', +'51: Low Load Activity Fuel [SB1 (201)]', +'52: Moderate Load Activity Fuel or Low Load Blowdown [SB2 (202)]', +'53: High Load Activity Fuel or Moderate Load Blowdown [SB3 (203)]', +'54: High Load Blowdown [SB4 (204)]' + fgi = 0.1660, 0.8960, 0.6740, 3.5910, 0.7840, 1.3440, 1.0910, 1.1200, 0.7800, 2.6920, 2.5820, 7.7490, 13.0240, 1.e-7, + 0.0224, 0.0224, 0.1121, 0.0560, 0.0897, 0.0224, 0.2242, 0.3363, 0.4483, + 0.0448, 0.2242, 0.1233, 0.5156, + 0.1121, 1.0088, 0.7734, 0.4932, 1.2778, 0.9751, 2.4659, 1.4123, 1.5580, + 0.5828, 0.8967, 0.3363, 1.0088, 2.4659, + 1.5244, 1.3226, 1.2329, 1.3899, 1.8046, 1.0760, 2.1969, 1.8606, 3.1608, + 3.4746, 2.8582, 2.5219, 3.1384 + fgi_lh = 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, + 0.0673, 0.2242, 0.3363, 0.4259, 0.5604, 0.7622, 1.2105, 1.6364, 2.0175, + 0.1121, 0.1345, 0.3250, 0.7622, + 0.0336, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.3475, + 0.0448, 0.0000, 0.1457, 0.0000, 0.0000, + 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, + 0.0000, 0.0000, 0.0000, 0.0000 + fueldepthm= 0.3050, 0.3050, 0.7620, 1.8290, 0.6100, 0.7620, 0.7620, 0.0610, 0.0610, 0.3050, 0.3050, 0.7010, 0.9140, 0.3050, + 0.1219, 0.3048, 0.6096, 0.6096, 0.4572, 0.4572, 0.9144, 1.2192, 1.5240, + 0.2743, 0.4572, 0.5486, 0.6401, + 0.3048, 0.3048, 0.7315, 0.9144, 1.8288, 0.6096, 1.8288, 0.9144, 1.3411, + 0.1829, 0.3048, 0.3962, 0.1524, 0.3048, + 0.0610, 0.0610, 0.0914, 0.1219, 0.1829, 0.0914, 0.1219, 0.0914, 0.1829, + 0.3048, 0.3048, 0.3658, 0.8230 + savr = 3500., 2784., 1500., 1739., 1683., 1564., 1562., 1889., 2484., 1764., 1182., 1145., 1159., 3500., + 2200., 2000., 1500., 2000., 1800., 2200., 2000., 1500., 1800., + 2000., 2000., 1800., 1800., + 2000., 2000., 1600., 2000., 750., 750., 750., 750., 750., + 2000., 2000., 1800., 2300., 1500., + 2000., 2000., 2000., 2000., 2000., 2000., 2000., 1800., 1800., + 2000., 2000., 2000., 2000. + fuelmce = 0.12, 0.15, 0.25, 0.20, 0.20, 0.25, 0.40, 0.30, 0.25, 0.25, 0.15, 0.20, 0.25, 0.12, + 0.15, 0.15, 0.30, 0.15, 0.40, 0.40, 0.15, 0.30, 0.40, + 0.15, 0.15, 0.40, 0.40, + 0.15, 0.15, 0.40, 0.30, 0.15, 0.30, 0.15, 0.40, 0.40, + 0.20, 0.30, 0.30, 0.12, 0.25, + 0.30, 0.25, 0.20, 0.25, 0.25, 0.25, 0.25, 0.35, 0.35, + 0.25, 0.25, 0.25, 0.25 + fueldens = 32., 32., 32., 32., 32., 32., 32., 32., 32., 32., 32., 32., 32., 32., ! 32 if solid, 19 if rotten + 32., 32., 32., 32., 32., 32., 32., 32., 32., + 32., 32., 32., 32., + 32., 32., 32., 32., 32., 32., 32., 32., 32., + 32., 32., 32., 32., 32., + 32., 32., 32., 32., 32., 32., 32., 32., 32., + 32., 32., 32., 32. + st = 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, + 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, + 0.0555, 0.0555, 0.0555, 0.0555, + 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, + 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, + 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, + 0.0555, 0.0555, 0.0555, 0.0555 + se = 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, + 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, + 0.010, 0.010, 0.010, 0.010, + 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, + 0.010, 0.010, 0.010, 0.010, 0.010, + 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, + 0.010, 0.010, 0.010, 0.010 + ! ----- Notes on weight: (4) - best fit of Latham data; (5)-(7) could be 60-120; (8)-(10) could be 300-1600; (11)-(13) could be 300-1600 + weight = 7., 7., 7., 180., 100., 100., 100., 900., 900., 900., 900., 900., 900., 7., + 7., 7., 7., 7., 7., 7., 7., 7., 7., + 7., 7., 7., 7., + 100., 100., 100., 100., 180., 100., 180., 100., 100., + 900., 900., 900., 900., 900., + 900., 900., 900., 900., 900., 900., 900., 900., 900., + 900., 900., 900., 900. + / diff --git a/test/em_fire/namelist.fire_fmc.sb40 b/test/em_fire/namelist.fire_fmc.sb40 new file mode 100644 index 0000000000..2ea79a7d49 --- /dev/null +++ b/test/em_fire/namelist.fire_fmc.sb40 @@ -0,0 +1,191 @@ +&fuel_scalars ! scalar fuel constants +cmbcnst = 17.433e+06, ! J/kg combustion heat dry fuel +hfgl = 17.e4 , ! W/m^2 heat flux to ignite canopy +fuelmc_g = 0.08, ! ground fuel moisture, set = 0 for dry +fuelmc_g_lh = 1.20, ! ground live herb fuel moisture, set = 0 for dry +fuelmc_c = 1.00, ! canopy fuel moisture, set = 0 for dry +nfuelcats = 54, ! number of fuel categories used +no_fuel_cat = 14 ! extra category for no fuel +/ + +&fuel_categories + fuel_name = +'1: Short grass (1 ft)', +'2: Timber (grass and understory)', +'3: Tall grass (2.5 ft)', +'4: Chaparral (6 ft)', +'5: Brush (2 ft) ', +'6: Dormant brush, hardwood slash', +'7: Southern rough', +'8: Closed timber litter', +'9: Hardwood litter', +'10: Timber (litter + understory)', +'11: Light logging slash', +'12: Medium logging slash', +'13: Heavy logging slash', +'14: no fuel', +'15: Short, Sparse Dry Climate Grass (Dynamic) [GR1 (101)]', +'16: Low Load, Dry Climate Grass (Dynamic) GR2 (102)', +'17: Low Load, Very Coarse, Humid Climate Grass (Dynamic) [GR3 (103)]', +'18: Moderate Load, Dry Climate Grass (Dynamic) [GR4 (104)]', +'19: Low Load, Humid Climate Grass (Dynamic) [GR5 (105)]', +'20: Moderate Load, Humid Climate Grass (Dynamic) [GR6 (106)]', +'21: High Load, Dry Climate Grass (Dynamic) [GR7 (107)]', +'22: High Load, Very Coarse, Humid Climate Grass (Dynamic) [GR8 (108)]', +'23: Very High Load, Humid Climate Grass (Dynamic) [GR9 (109)]', +'24: Low Load, Dry Climate Grass-Shrub (Dynamic) [GS1 (121)]', +'25: Moderate Load, Dry Climate Grass-Shrub (Dynamic) [GS2 (122)]', +'26: Moderate Load, Humid Climate Grass-Shrub (Dynamic) [GS3 (123)]', +'27: High Load, Humid Climate Grass-Shrub (Dynamic) [GS4 (124)]', +'28: Low Load Dry Climate Shrub (Dynamic) [SH1 (141)]', +'29: Moderate Load Dry Climate Shrub [SH2 (142)]', +'30: Moderate Load, Humid Climate Shrub [SH3 (143)]', +'31: Low Load, Humid Climate Timber-Shrub [SH4 (144)]', +'32: High Load, Dry Climate Shrub [SH5 (145)]', +'33: Low Load, Humid Climate Shrub [SH6 (146)]', +'34: Very High Load, Dry Climate Shrub [SH7 (147)]', +'35: High Load, Humid Climate Shrub [SH8 (148)]', +'36: Very High Load, Humid Climate Shrub (Dynamic) [SH9 (149)]', +'37: Low Load Dry Climate Timber-Grass-Shrub (Dynamic) [TU1 (161)]', +'38: Moderate Load, Humid Climate Timber-Shrub [TU2 (162)]', +'39: Moderate Load, Humid Climate Timber-Grass-Shrub (Dynamic) [TU3 (163)]', +'40: Dwarf Conifer With Understory [TU4 (164)]', +'41: Very High Load, Dry Climate Timber-Shrub [TU5 (165)]', +'42: Low Load Compact Conifer Litter [TL1 (181)]', +'43: Low Load Broadleaf Litter [TL2 (182)]', +'44: Moderate Load Conifer Litter [TL3 (183)]', +'45: Small downed logs [TL4 (184)]', +'46: High Load Conifer Litter [TL5 (185)]', +'47: Moderate Load Broadleaf Litter [TL6 (186)]', +'48: Large Downed Logs [TL7 (187)]', +'49: Long-Needle Litter [TL8 (188)]', +'50: Very High Load Broadleaf Litter [TL9 (189)]', +'51: Low Load Activity Fuel [SB1 (201)]', +'52: Moderate Load Activity Fuel or Low Load Blowdown [SB2 (202)]', +'53: High Load Activity Fuel or Moderate Load Blowdown [SB3 (203)]', +'54: High Load Blowdown [SB4 (204)]' + fgi = 0.1660, 0.8960, 0.6740, 3.5910, 0.7840, 1.3440, 1.0910, 1.1200, 0.7800, 2.6920, 2.5820, 7.7490, 13.0240, 1.e-7, + 0.0224, 0.0224, 0.1121, 0.0560, 0.0897, 0.0224, 0.2242, 0.3363, 0.4483, + 0.0448, 0.2242, 0.1233, 0.5156, + 0.1121, 1.0088, 0.7734, 0.4932, 1.2778, 0.9751, 2.4659, 1.4123, 1.5580, + 0.5828, 0.8967, 0.3363, 1.0088, 2.4659, + 1.5244, 1.3226, 1.2329, 1.3899, 1.8046, 1.0760, 2.1969, 1.8606, 3.1608, + 3.4746, 2.8582, 2.5219, 3.1384 + fgi_lh = 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, + 0.0673, 0.2242, 0.3363, 0.4259, 0.5604, 0.7622, 1.2105, 1.6364, 2.0175, + 0.1121, 0.1345, 0.3250, 0.7622, + 0.0336, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.3475, + 0.0448, 0.0000, 0.1457, 0.0000, 0.0000, + 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, + 0.0000, 0.0000, 0.0000, 0.0000 + fueldepthm= 0.3050, 0.3050, 0.7620, 1.8290, 0.6100, 0.7620, 0.7620, 0.0610, 0.0610, 0.3050, 0.3050, 0.7010, 0.9140, 0.3050, + 0.1219, 0.3048, 0.6096, 0.6096, 0.4572, 0.4572, 0.9144, 1.2192, 1.5240, + 0.2743, 0.4572, 0.5486, 0.6401, + 0.3048, 0.3048, 0.7315, 0.9144, 1.8288, 0.6096, 1.8288, 0.9144, 1.3411, + 0.1829, 0.3048, 0.3962, 0.1524, 0.3048, + 0.0610, 0.0610, 0.0914, 0.1219, 0.1829, 0.0914, 0.1219, 0.0914, 0.1829, + 0.3048, 0.3048, 0.3658, 0.8230 + savr = 3500., 2784., 1500., 1739., 1683., 1564., 1562., 1889., 2484., 1764., 1182., 1145., 1159., 3500., + 2200., 2000., 1500., 2000., 1800., 2200., 2000., 1500., 1800., + 2000., 2000., 1800., 1800., + 2000., 2000., 1600., 2000., 750., 750., 750., 750., 750., + 2000., 2000., 1800., 2300., 1500., + 2000., 2000., 2000., 2000., 2000., 2000., 2000., 1800., 1800., + 2000., 2000., 2000., 2000. + fuelmce = 0.12, 0.15, 0.25, 0.20, 0.20, 0.25, 0.40, 0.30, 0.25, 0.25, 0.15, 0.20, 0.25, 0.12, + 0.15, 0.15, 0.30, 0.15, 0.40, 0.40, 0.15, 0.30, 0.40, + 0.15, 0.15, 0.40, 0.40, + 0.15, 0.15, 0.40, 0.30, 0.15, 0.30, 0.15, 0.40, 0.40, + 0.20, 0.30, 0.30, 0.12, 0.25, + 0.30, 0.25, 0.20, 0.25, 0.25, 0.25, 0.25, 0.35, 0.35, + 0.25, 0.25, 0.25, 0.25 + fueldens = 32., 32., 32., 32., 32., 32., 32., 32., 32., 32., 32., 32., 32., 32., ! 32 if solid, 19 if rotten + 32., 32., 32., 32., 32., 32., 32., 32., 32., + 32., 32., 32., 32., + 32., 32., 32., 32., 32., 32., 32., 32., 32., + 32., 32., 32., 32., 32., + 32., 32., 32., 32., 32., 32., 32., 32., 32., + 32., 32., 32., 32. + st = 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, + 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, + 0.0555, 0.0555, 0.0555, 0.0555, + 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, + 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, + 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, 0.0555, + 0.0555, 0.0555, 0.0555, 0.0555 + se = 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, + 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, + 0.010, 0.010, 0.010, 0.010, + 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, + 0.010, 0.010, 0.010, 0.010, 0.010, + 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, 0.010, + 0.010, 0.010, 0.010, 0.010 + ! ----- Notes on weight: (4) - best fit of Latham data; (5)-(7) could be 60-120; (8)-(10) could be 300-1600; (11)-(13) could be 300-1600 + weight = 7., 7., 7., 180., 100., 100., 100., 900., 900., 900., 900., 900., 900., 7., + 7., 7., 7., 7., 7., 7., 7., 7., 7., + 7., 7., 7., 7., + 100., 100., 100., 100., 180., 100., 180., 100., 100., + 900., 900., 900., 900., 900., + 900., 900., 900., 900., 900., 900., 900., 900., 900., + 900., 900., 900., 900. + +! fuel loading 1-h, 10-h, 100-h, 1000-h, live following Albini 1976 as reprinted in Anderson 1982 Table 1 +! for relative proportions between classes only +! TWJ added values for S&B model in corresponding rows +! 1 2 3 4 5 6 7 8 9 10 11 12 13 + fgi_1h = 0.74, 2.00, 3.01, 5.01, 1.00, 1.50, 1.13, 1.50, 2.92, 3.01, 1.50, 4.01, 7.01, + 0.10, 0.10, 0.10, 0.25, 0.40, 0.10, 1.00, 0.50, 1.00, + 0.20, 0.50, 0.30, 1.90, + 0.25, 1.35, 0.45, 0.85, 3.60, 2.90, 3.50, 2.05, 4.50, + 0.20, 0.95, 1.10, 4.50, 4.00, + 1.00, 1.40, 0.50, 0.50, 1.15, 2.40, 0.30, 5.80, 6.65, + 1.50, 4.50, 5.50, 5.25 + fgi_10h = 0.000, 1.00, 0.00, 4.01, 0.50, 2.50, 1.87, 1.00, 0.41, 2.00, 4.51, 14.03, 23.04, + 0.00, 0.00, 0.40, 0.00, 0.00, 0.00, 0.00, 1.00, 1.00, + 0.00, 0.50, 0.25, 0.30, + 0.25, 2.40, 3.00, 1.15, 2.10, 1.45, 5.30, 3.40, 2.45, + 0.90, 1.80, 0.15, 0.00, 4.00, + 2.20, 2.30, 2.20, 1.50, 2.50, 1.20, 1.40, 1.40, 3.30, + 3.00, 4.25, 2.75, 3.50 + fgi_100h = 0.000, 0.50, 0.00, 2.00, 0.00, 2.00, 1.50, 2.50, 0.15, 5.01, 5.51, 16.53, 28.05, + 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, + 0.00, 0.00, 0.00, 0.10, + 0.00, 0.75, 0.00, 0.20, 0.00, 0.00, 2.20, 0.85, 0.00, + 1.50, 1.25, 0.25, 0.00, 3.00, + 3.60, 2.20, 2.80, 4.20, 4.40, 1.20, 8.10, 1.10, 4.15, + 11.00, 4.00, 3.00, 5.25 + fgi_1000h = 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, + 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, + 0.00, 0.00, 0.00, 0.00, + 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, + 0.00, 0.00, 0.00, 0.00, 0.00, + 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, + 0.00, 0.00, 0.00, 0.00 + fgi_live = 0.000, 0.50, 0.000, 5.01, 2.00, 0.00, 0.37, 0.00, 0.00, 2.00, 0.00, 2.3, 0.00, + 0.30, 1.00, 1.50, 1.90, 2.50, 3.40, 5.40, 7.30, 9.00, + 0.50, 0.60, 1.45, 3.40, + 0.15, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 1.55, + 0.20, 0.00, 0.65, 0.00, 0.00, + 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, + 0.00, 0.00, 0.00, 0.00 + / + +&fuel_moisture +! Fuel moisture model coefficients to experiment with different models. +! Can be omitted, then the defaults in the code are used. +moisture_classes = 5, +moisture_class_name= '1-h','10-h','100-h','1000-h','Live', ! identification to be printed +drying_model= 1, 1, 1, 1, 1, ! number of model - only 1= equilibrium moisture Van Wagner (1972) per Viney (1991) allowed +drying_lag= 1, 10, 100, 1000, 1e9, ! so-called 10hr and 100hr fuel +wetting_model= 1, 1, 1, 1, 1, ! number of model - only 1= allowed at this moment +wetting_lag= 1.4, 14.0, 140.0, 1400.0, 1e9, ! 10-h lag callibrated to VanWagner&Pickett 1985, Canadian fire danger rating system, rest by scaling +saturation_moisture= 2.5, 2.5, 2.5, 2.5, 2.5, ! ditto +saturation_rain = 8.0, 8.0, 8.0, 8.0, 8.0, ! stronger rain than this (mm/h) does not make much difference. +rain_threshold = 0.05, 0.05, 0.05, 0.05, 0.05,! mm/h rain too weak to wet anything. +fmc_gc_initialization= 2, 2, 2, 2, 3,! 0: from wrfinput, 1:from fuelmc_g, 2: from equilibrium, 3: from fmc_1h,...,fmc_live +fmc_1h = 0.08, ! as in fuelmc_g, used only if fmc_gc_initialization(1) = 3 +fmc_10h = 0.08, ! as in fuelmc_g, used only if fmc_gc_initialization(2) = 3 +fmc_100h = 0.08, ! as in fuelmc_g, used only if fmc_gc_initialization(3) = 3 +fmc_1000h = 0.08, ! as in fuelmc_g, used only if fmc_gc_initialization(4) = 3 +fmc_live = 0.30, ! Completely cured, used only if fmc_gc_initialization(5) = 3 +/ From b36b3ecd175baaa9cb7ede52ddafbbe2cedee38b Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Thu, 11 Jan 2024 19:52:26 -0700 Subject: [PATCH 29/41] Updates to MYNN-EDMF (#1938) TYPE: bug fix and enhancement KEYWORDS: MYNN-EDMF, subgrid clouds, code optimization SOURCE: Joseph Olson (NOAA-GSL) DESCRIPTION OF CHANGES: Problems: 1. lack of loop vectorization due to logicals inside loops 2. stratus subgrid clouds had a limited cloud-radiative impact 3. mass flux scheme was too inactive over water 4. upper-level clouds were lacking radiative impact Solutions: 1. Optimization work: fixed 8-plume model instead of variable number plume. maintains performance, allows more vectorization, and removed some logic outside of loops. This required a change in the output variables (nupdrafts is no longer useful, replaced by maxwidth and ztop_plume). 2. Bug fix to correct grid mean vs in-cloud mixing ratios. Now all subgrid clouds (mass-flux and stratus) are output as grid means and the addition of subgrid clouds to the resolved cloud in the radiation driver was corrected. 3. Adjustments to cloud pdf and diffusion to better fit modifications to the Thompson-Eidhammer aerosol-aware scheme over the marine boundary layer. This will require updates to the Thompson-Eidhammer scheme to be optimal. We consider this work in progress, but the results are still positive overall, especially in the tropics. 4. Added a patch to ensure robust cloud fractions were diagnosed for radiatively significant water, ice, & snow mixing ratios. LIST OF MODIFIED FILES: M Registry/Registry.EM_COMMON M dyn_em/module_first_rk_step_part1.F M phys/module_bl_mynn.F M phys/module_bl_mynn_common.F M phys/module_bl_mynn_wrapper.F M phys/module_pbl_driver.F M phys/module_radiation_driver.F M main/depend.common M phys/Makefile A phys/ccpp_kind_types.F TESTS CONDUCTED: 1. See attached pdf 2. It passed the regression tests. RELEASE NOTE: See notes above and this [Overview of Updates to MYNN-EDMF.pdf](https://github.com/wrf-model/WRF/files/13400986/Overview.of.Updates.to.MYNN-EDMF.pdf). --- Registry/Registry.EM_COMMON | 5 +- dyn_em/module_first_rk_step_part1.F | 4 +- main/depend.common | 2 + phys/Makefile | 1 + phys/ccpp_kind_types.F | 8 + phys/module_bl_mynn.F | 3630 ++++++++++++++------------- phys/module_bl_mynn_common.F | 55 +- phys/module_bl_mynn_wrapper.F | 172 +- phys/module_pbl_driver.F | 15 +- phys/module_radiation_driver.F | 4 +- 10 files changed, 1977 insertions(+), 1919 deletions(-) create mode 100644 phys/ccpp_kind_types.F diff --git a/Registry/Registry.EM_COMMON b/Registry/Registry.EM_COMMON index 889a92854b..3e0231ff29 100644 --- a/Registry/Registry.EM_COMMON +++ b/Registry/Registry.EM_COMMON @@ -1123,9 +1123,10 @@ state real sub_thl3D ikj misc 1 - h "s state real sub_sqv3D ikj misc 1 - h "sub_sqv3D" "qv subsidence tendency from EDMF" "kg kg-1 s-1" state real det_thl3D ikj misc 1 - h "det_thl3D" "thetaL detrainment tendency from EDMF" "K s-1" state real det_sqv3D ikj misc 1 - h "det_sqv3D" "qv detrainment tendency from EDMF" "kg kg-1 s-1" -state integer nupdraft ij misc 1 - h "nupdraft" "Number of updrafts per grid cell" "" state integer ktop_plume ij misc 1 - h "ktop_plume" "k-level of highest pentrating plume" "" state real maxMF ij misc 1 - h "maxMF" "Maximum mass-flux (neg: all dry, pos: moist)" "m/s * area" +state real maxwidth ij misc 1 - h "maxwidth" "Maximum plume width" "m" +state real ztop_plume ij misc 1 - h "ztop_plume" "Height of tallest plume" "m" #FogDES variables state real fgdp ij misc 1 - - "fgdp" "Accumulated fog deposition" "mm" @@ -3133,7 +3134,7 @@ package kepsscheme bl_pbl_physics==17 - scalar:tke_ad package mrfscheme bl_pbl_physics==99 - - package tkebudget tke_budget==1 - state:qSHEAR,qBUOY,qDISS,qWT,dqke -package mynn_dmp_edmf bl_mynn_edmf==1 - state:ktop_plume,maxmf,nupdraft +package mynn_dmp_edmf bl_mynn_edmf==1 - state:ktop_plume,ztop_plume,maxmf,maxwidth package mynn_3Doutput bl_mynn_output==1 - state:edmf_a,edmf_w,edmf_thl,edmf_qt,edmf_ent,edmf_qc,sub_thl3D,sub_sqv3D,det_thl3D,det_sqv3D package pbl_cloud icloud_bl==1 - state:cldfra_bl,qc_bl,qi_bl diff --git a/dyn_em/module_first_rk_step_part1.F b/dyn_em/module_first_rk_step_part1.F index 157f260be8..10d73577e0 100644 --- a/dyn_em/module_first_rk_step_part1.F +++ b/dyn_em/module_first_rk_step_part1.F @@ -1223,8 +1223,8 @@ SUBROUTINE first_rk_step_part1 ( grid , config_flags & & ,rmol=grid%rmol, ch=grid%ch & & ,qcg=grid%qcg, grav_settling=config_flags%grav_settling & ! & ,K_m=grid%K_m, K_h=grid%K_h, K_q=grid%K_q & - & ,vdfg=grid%vdfg,nupdraft=grid%nupdraft,maxMF=grid%maxmf & - & ,ktop_plume=grid%ktop_plume & + & ,vdfg=grid%vdfg,maxwidth=grid%maxwidth,maxMF=grid%maxmf & + & ,ztop_plume=grid%ztop_plume,ktop_plume=grid%ktop_plume & & ,spp_pbl=config_flags%spp_pbl & & ,pattern_spp_pbl=grid%pattern_spp_pbl & & ,restart=config_flags%restart,cycling=config_flags%cycling & diff --git a/main/depend.common b/main/depend.common index 293dfd4df8..65ee00c3b3 100644 --- a/main/depend.common +++ b/main/depend.common @@ -179,6 +179,8 @@ module_bl_gfs.o: module_gfs_machine.o \ module_bl_gfsedmf.o: module_gfs_machine.o \ module_gfs_physcons.o +module_bl_mynn_common.o: ccpp_kind_types.o + module_bl_mynn.o: module_bl_mynn_common.o module_bl_mynn_wrapper.o: module_bl_mynn.o \ diff --git a/phys/Makefile b/phys/Makefile index e9974cd3f1..c57fcf0e58 100644 --- a/phys/Makefile +++ b/phys/Makefile @@ -6,6 +6,7 @@ RM = rm -f MODULES = \ + ccpp_kind_types.o \ module_bep_bem_helper.o \ complex_number_module.o \ module_cam_shr_kind_mod.o \ diff --git a/phys/ccpp_kind_types.F b/phys/ccpp_kind_types.F new file mode 100644 index 0000000000..9360bbf67e --- /dev/null +++ b/phys/ccpp_kind_types.F @@ -0,0 +1,8 @@ +module ccpp_kind_types +#if ( RWORDSIZE == 4 ) + integer, parameter :: kind_phys = selected_real_kind(6) +#else + integer, parameter :: kind_phys = selected_real_kind(12) +#endif + contains +end module ccpp_kind_types diff --git a/phys/module_bl_mynn.F b/phys/module_bl_mynn.F index e1bf567411..9eb0e65521 100644 --- a/phys/module_bl_mynn.F +++ b/phys/module_bl_mynn.F @@ -121,7 +121,7 @@ ! Hybrid PBL height diagnostic, which blends a theta-v-based ! definition in neutral/convective BL and a TKE-based definition ! in stable conditions. -! TKE budget output option (bl_mynn_tkebudget) +! TKE budget output option ! v3.5.0: TKE advection option (bl_mynn_tkeadvect) ! v3.5.1: Fog deposition related changes. ! v3.6.0: Removed fog deposition from the calculation of tendencies @@ -232,13 +232,25 @@ ! bl_mynn_cloudpdf = 2 (Chab-Becht). ! Removed WRF_CHEM dependencies. ! Many miscellaneous tweaks. +! v4.5.2 / CCPP +! Some code optimization. Removed many conditions from loops. Redesigned the mass- +! flux scheme to use 8 plumes instead of a variable n plumes. This results in +! the removal of the output variable "nudprafts" and adds maxwidth and ztop_plume. +! Revision option bl_mynn_cloudpdf = 2, which now ensures cloud fractions for all +! optically relevant mixing ratios (tip from Greg Thompson). Also, added flexibility +! for tuning near-surface cloud fractions to remove excess fog/low ceilings. +! Now outputs all SGS cloud mixing ratios as grid-mean values, not in-cloud. This +! results in a change in the pre-radiation code to no longer multiply mixing ratios +! by cloud fractions. +! Lots of code cleanup: removal of test code, comments, changing text case, etc. +! Many misc tuning/tweaks. ! ! Many of these changes are now documented in references listed above. !==================================================================== MODULE module_bl_mynn - use module_bl_mynn_common,only: & + use module_bl_mynn_common,only: & cp , cpv , cliq , cice , & p608 , ep_2 , ep_3 , gtr , & grav , g_inv , karman , p1000mb , & @@ -256,45 +268,45 @@ MODULE module_bl_mynn !=================================================================== ! From here on, these are MYNN-specific parameters: ! The parameters below depend on stability functions of module_sf_mynn. - REAL, PARAMETER :: cphm_st=5.0, cphm_unst=16.0, & - cphh_st=5.0, cphh_unst=16.0 + real(kind_phys), parameter :: cphm_st=5.0, cphm_unst=16.0, & + cphh_st=5.0, cphh_unst=16.0 ! Closure constants - REAL, PARAMETER :: & - &pr = 0.74, & - &g1 = 0.235, & ! NN2009 = 0.235 - &b1 = 24.0, & - &b2 = 15.0, & ! CKmod NN2009 - &c2 = 0.729, & ! 0.729, & !0.75, & - &c3 = 0.340, & ! 0.340, & !0.352, & - &c4 = 0.0, & - &c5 = 0.2, & + real(kind_phys), parameter :: & + &pr = 0.74, & + &g1 = 0.235, & ! NN2009 = 0.235 + &b1 = 24.0, & + &b2 = 15.0, & ! CKmod NN2009 + &c2 = 0.729, & ! 0.729, & !0.75, & + &c3 = 0.340, & ! 0.340, & !0.352, & + &c4 = 0.0, & + &c5 = 0.2, & &a1 = b1*( 1.0-3.0*g1 )/6.0, & ! &c1 = g1 -1.0/( 3.0*a1*b1**(1.0/3.0) ), & &c1 = g1 -1.0/( 3.0*a1*2.88449914061481660), & &a2 = a1*( g1-c1 )/( g1*pr ), & &g2 = b2/b1*( 1.0-c3 ) +2.0*a1/b1*( 3.0-2.0*c2 ) - REAL, PARAMETER :: & - &cc2 = 1.0-c2, & - &cc3 = 1.0-c3, & - &e1c = 3.0*a2*b2*cc3, & - &e2c = 9.0*a1*a2*cc2, & + real(kind_phys), parameter :: & + &cc2 = 1.0-c2, & + &cc3 = 1.0-c3, & + &e1c = 3.0*a2*b2*cc3, & + &e2c = 9.0*a1*a2*cc2, & &e3c = 9.0*a2*a2*cc2*( 1.0-c5 ), & - &e4c = 12.0*a1*a2*cc2, & + &e4c = 12.0*a1*a2*cc2, & &e5c = 6.0*a1*a1 ! Constants for min tke in elt integration (qmin), max z/L in els (zmax), ! and factor for eddy viscosity for TKE (Kq = Sqfac*Km): - REAL, PARAMETER :: qmin=0.0, zmax=1.0, Sqfac=3.0 + real(kind_phys), parameter :: qmin=0.0, zmax=1.0, Sqfac=3.0 ! Note that the following mixing-length constants are now specified in mym_length ! &cns=3.5, alp1=0.23, alp2=0.3, alp3=3.0, alp4=10.0, alp5=0.2 - REAL, PARAMETER :: gpw=5./3., qcgmin=1.e-8, qkemin=1.e-12 - REAL, PARAMETER :: tliq = 269. !all hydrometeors are liquid when T > tliq + real(kind_phys), parameter :: gpw=5./3., qcgmin=1.e-8, qkemin=1.e-12 + real(kind_phys), parameter :: tliq = 269. !all hydrometeors are liquid when T > tliq ! Constants for cloud PDF (mym_condensation) - REAL, PARAMETER :: rr2=0.7071068, rrp=0.3989423 + real(kind_phys), parameter :: rr2=0.7071068, rrp=0.3989423 !>Use Canuto/Kitamura mod (remove Ric and negative TKE) (1:yes, 0:no) !!For more info, see Canuto et al. (2008 JAS) and Kitamura (Journal of the @@ -304,61 +316,34 @@ MODULE module_bl_mynn !!(above) back to NN2009 values (see commented out lines next to the !!parameters above). This only removes the negative TKE problem !!but does not necessarily improve performance - neutral impact. - REAL, PARAMETER :: CKmod=1. + real(kind_phys), parameter :: CKmod=1. !>Use Ito et al. (2015, BLM) scale-aware (0: no, 1: yes). Note that this also has impacts - !!on the cloud PDF and mass-flux scheme, using Honnert et al. (2011) similarity function - !!for TKE in the upper PBL/cloud layer. - REAL, PARAMETER :: scaleaware=1. + !!on the cloud PDF and mass-flux scheme, using LES-derived similarity function. + real(kind_phys), parameter :: scaleaware=1. !>Of the following the options, use one OR the other, not both. !>Adding top-down diffusion driven by cloud-top radiative cooling - INTEGER, PARAMETER :: bl_mynn_topdown = 0 + integer, parameter :: bl_mynn_topdown = 0 !>Option to activate downdrafts, from Elynn Wu (0: deactive, 1: active) - INTEGER, PARAMETER :: bl_mynn_edmf_dd = 0 + integer, parameter :: bl_mynn_edmf_dd = 0 !>Option to activate heating due to dissipation of TKE (to activate, set to 1.0) - INTEGER, PARAMETER :: dheat_opt = 1 + integer, parameter :: dheat_opt = 1 !Option to activate environmental subsidence in mass-flux scheme - LOGICAL, PARAMETER :: env_subs = .false. + logical, parameter :: env_subs = .false. !Option to switch flux-profile relationship for surface (from Puhales et al. 2020) !0: use original Dyer-Hicks, 1: use Cheng-Brustaert and Blended COARE - INTEGER, PARAMETER :: bl_mynn_stfunc = 1 + integer, parameter :: bl_mynn_stfunc = 1 !option to print out more stuff for debugging purposes - LOGICAL, PARAMETER :: debug_code = .false. - INTEGER, PARAMETER :: idbg = 23 !specific i-point to write out - -! JAYMES- -!> Constants used for empirical calculations of saturation -!! vapor pressures (in function "esat") and saturation mixing ratios -!! (in function "qsat"), reproduced from module_mp_thompson.F, -!! v3.6 - REAL, PARAMETER:: J0= .611583699E03 - REAL, PARAMETER:: J1= .444606896E02 - REAL, PARAMETER:: J2= .143177157E01 - REAL, PARAMETER:: J3= .264224321E-1 - REAL, PARAMETER:: J4= .299291081E-3 - REAL, PARAMETER:: J5= .203154182E-5 - REAL, PARAMETER:: J6= .702620698E-8 - REAL, PARAMETER:: J7= .379534310E-11 - REAL, PARAMETER:: J8=-.321582393E-13 - - REAL, PARAMETER:: K0= .609868993E03 - REAL, PARAMETER:: K1= .499320233E02 - REAL, PARAMETER:: K2= .184672631E01 - REAL, PARAMETER:: K3= .402737184E-1 - REAL, PARAMETER:: K4= .565392987E-3 - REAL, PARAMETER:: K5= .521693933E-5 - REAL, PARAMETER:: K6= .307839583E-7 - REAL, PARAMETER:: K7= .105785160E-9 - REAL, PARAMETER:: K8= .161444444E-12 -! end- + logical, parameter :: debug_code = .false. + integer, parameter :: idbg = 23 !specific i-point to write out ! Used in WRF-ARW module_physics_init.F - INTEGER :: mynn_level + integer :: mynn_level CONTAINS @@ -375,7 +360,7 @@ SUBROUTINE mynn_bl_driver( & &initflag,restart,cycling, & &delt,dz,dx,znt, & &u,v,w,th,sqv3d,sqc3d,sqi3d, & - &qnc,qni, & + &sqs3d,qnc,qni, & &qnwfa,qnifa,qnbca,ozone, & &p,exner,rho,t3d, & &xland,ts,qsfc,ps, & @@ -391,7 +376,7 @@ SUBROUTINE mynn_bl_driver( & &tsq,qsq,cov, & &rublten,rvblten,rthblten, & &rqvblten,rqcblten,rqiblten, & - &rqncblten,rqniblten, & + &rqncblten,rqniblten,rqsblten, & &rqnwfablten,rqnifablten, & &rqnbcablten,dozone, & &exch_h,exch_m, & @@ -415,44 +400,47 @@ SUBROUTINE mynn_bl_driver( & &edmf_thl,edmf_ent,edmf_qc, & &sub_thl3D,sub_sqv3D, & &det_thl3D,det_sqv3D, & - &nupdraft,maxMF,ktop_plume, & + &maxwidth,maxMF,ztop_plume, & + &ktop_plume, & &spp_pbl,pattern_spp_pbl, & &rthraten, & &FLAG_QC,FLAG_QI,FLAG_QNC, & - &FLAG_QNI,FLAG_QNWFA,FLAG_QNIFA, & - &FLAG_QNBCA, & + &FLAG_QNI,FLAG_QS, & + &FLAG_QNWFA,FLAG_QNIFA, & + &FLAG_QNBCA,FLAG_OZONE, & &IDS,IDE,JDS,JDE,KDS,KDE, & &IMS,IME,JMS,JME,KMS,KME, & &ITS,ITE,JTS,JTE,KTS,KTE ) !------------------------------------------------------------------- - INTEGER, INTENT(in) :: initflag + integer, intent(in) :: initflag !INPUT NAMELIST OPTIONS: - LOGICAL, INTENT(in) :: restart,cycling - INTEGER, INTENT(in) :: tke_budget - INTEGER, INTENT(in) :: bl_mynn_cloudpdf - INTEGER, INTENT(in) :: bl_mynn_mixlength - INTEGER, INTENT(in) :: bl_mynn_edmf - LOGICAL, INTENT(in) :: bl_mynn_tkeadvect - INTEGER, INTENT(in) :: bl_mynn_edmf_mom - INTEGER, INTENT(in) :: bl_mynn_edmf_tke - INTEGER, INTENT(in) :: bl_mynn_mixscalars - INTEGER, INTENT(in) :: bl_mynn_output - INTEGER, INTENT(in) :: bl_mynn_cloudmix - INTEGER, INTENT(in) :: bl_mynn_mixqt - INTEGER, INTENT(in) :: icloud_bl - REAL, INTENT(in) :: closure - - LOGICAL, INTENT(in) :: FLAG_QI,FLAG_QNI,FLAG_QC,FLAG_QNC,& - FLAG_QNWFA,FLAG_QNIFA,FLAG_QNBCA - - LOGICAL, INTENT(IN) :: mix_chem,enh_mix,rrfs_sd,smoke_dbg - - INTEGER, INTENT(in) :: & - & IDS,IDE,JDS,JDE,KDS,KDE & - &,IMS,IME,JMS,JME,KMS,KME & - &,ITS,ITE,JTS,JTE,KTS,KTE + logical, intent(in) :: restart,cycling + integer, intent(in) :: tke_budget + integer, intent(in) :: bl_mynn_cloudpdf + integer, intent(in) :: bl_mynn_mixlength + integer, intent(in) :: bl_mynn_edmf + logical, intent(in) :: bl_mynn_tkeadvect + integer, intent(in) :: bl_mynn_edmf_mom + integer, intent(in) :: bl_mynn_edmf_tke + integer, intent(in) :: bl_mynn_mixscalars + integer, intent(in) :: bl_mynn_output + integer, intent(in) :: bl_mynn_cloudmix + integer, intent(in) :: bl_mynn_mixqt + integer, intent(in) :: icloud_bl + real(kind_phys), intent(in) :: closure + + logical, intent(in) :: FLAG_QI,FLAG_QNI,FLAG_QC,FLAG_QNC,& + FLAG_QNWFA,FLAG_QNIFA,FLAG_QNBCA, & + FLAG_OZONE,FLAG_QS + + logical, intent(in) :: mix_chem,enh_mix,rrfs_sd,smoke_dbg + + integer, intent(in) :: & + & IDS,IDE,JDS,JDE,KDS,KDE & + &,IMS,IME,JMS,JME,KMS,KME & + &,ITS,ITE,JTS,JTE,KTS,KTE #ifdef HARDCODE_VERTICAL # define kts 1 @@ -464,124 +452,135 @@ SUBROUTINE mynn_bl_driver( & ! closure : <= 2.5; Level 2.5 ! 2.5< and <3; Level 2.6 ! = 3; Level 3 + +! SGT: Changed this to use assumed shape arrays (dimension(:,:,:)) with no "optional" arguments +! to prevent a crash on Cheyenne. Do not change it back without testing if the code runs +! on Cheyenne with the GNU compiler. - REAL, INTENT(in) :: delt - REAL, DIMENSION(IMS:IME), INTENT(in) :: dx - REAL, DIMENSION(IMS:IME,KMS:KME), INTENT(in) :: dz, & - &u,v,w,th,sqv3D,p,exner,rho,t3d - REAL, DIMENSION(IMS:IME,KMS:KME), OPTIONAL, INTENT(in):: & - &sqc3D,sqi3D,qni,qnc,qnwfa,qnifa,qnbca - REAL, DIMENSION(IMS:IME,KMS:KME), OPTIONAL, INTENT(in):: ozone - REAL, DIMENSION(IMS:IME), INTENT(in) :: xland,ust, & - &ch,ts,qsfc,ps,hfx,qfx,wspd,uoce,voce,znt - - REAL, DIMENSION(IMS:IME,KMS:KME), INTENT(inout) :: & - &qke,tsq,qsq,cov,qke_adv - - REAL, DIMENSION(IMS:IME,KMS:KME), INTENT(inout) :: & - &rublten,rvblten,rthblten,rqvblten,rqcblten, & - &rqiblten,rqniblten,rqncblten, & + real(kind_phys), intent(in) :: delt + real(kind_phys), dimension(ims:ime), intent(in) :: dx + real(kind_phys), dimension(ims:ime,kms:kme), intent(in) :: dz, & + &u,v,w,th,sqv3D,p,exner,rho,T3D + real(kind_phys), dimension(ims:ime,kms:kme), optional, intent(in) :: & + &sqc3D,sqi3D,sqs3D,qni,qnc,qnwfa,qnifa,qnbca + real(kind_phys), dimension(ims:ime,kms:kme), optional,intent(in):: ozone + real(kind_phys), dimension(ims:ime), intent(in):: ust, & + &ch,qsfc,ps,wspd + real(kind_phys), dimension(ims:ime,kms:kme), intent(inout) :: & + &Qke,Tsq,Qsq,Cov,qke_adv + real(kind_phys), dimension(ims:ime,kms:kme), intent(inout) :: & + &rublten,rvblten,rthblten,rqvblten,rqcblten, & + &rqiblten,rqsblten,rqniblten,rqncblten, & &rqnwfablten,rqnifablten,rqnbcablten - REAL, DIMENSION(IMS:IME,KMS:KME), INTENT(inout) :: dozone - - REAL, DIMENSION(IMS:IME,KMS:KME), INTENT(in) :: rthraten + real(kind_phys), dimension(ims:ime,kms:kme), intent(inout) :: dozone + real(kind_phys), dimension(ims:ime,kms:kme), intent(in) :: rthraten - REAL, DIMENSION(IMS:IME,KMS:KME), INTENT(out) :: & - &exch_h,exch_m + real(kind_phys), dimension(ims:ime,kms:kme), intent(out) :: exch_h,exch_m + real(kind_phys), dimension(ims:ime), intent(in) :: xland, & + &ts,znt,hfx,qfx,uoce,voce !These 10 arrays are only allocated when bl_mynn_output > 0 - REAL, DIMENSION(IMS:IME,KMS:KME), OPTIONAL, INTENT(inout) :: & - & edmf_a,edmf_w,edmf_qt,edmf_thl,edmf_ent,edmf_qc, & + real(kind_phys), dimension(ims:ime,kms:kme), optional, intent(inout) :: & + & edmf_a,edmf_w,edmf_qt,edmf_thl,edmf_ent,edmf_qc, & & sub_thl3D,sub_sqv3D,det_thl3D,det_sqv3D -! REAL, DIMENSION(IMS:IME,KMS:KME) :: & +! real, dimension(ims:ime,kms:kme) :: & ! & edmf_a_dd,edmf_w_dd,edmf_qt_dd,edmf_thl_dd,edmf_ent_dd,edmf_qc_dd - REAL, DIMENSION(IMS:IME), INTENT(inout) :: pblh,rmol + real(kind_phys), dimension(ims:ime), intent(inout) :: pblh + real(kind_phys), dimension(ims:ime), intent(inout) :: rmol - REAL, DIMENSION(IMS:IME) :: psig_bl,psig_shcu + real(kind_phys), dimension(ims:ime) :: psig_bl,psig_shcu - INTEGER,DIMENSION(IMS:IME),INTENT(INOUT) :: & - &kpbl,nupdraft,ktop_plume + integer,dimension(ims:ime),intent(inout) :: & + &KPBL,ktop_plume - REAL, DIMENSION(IMS:IME), INTENT(OUT) :: & - &maxmf + real(kind_phys), dimension(ims:ime), intent(out) :: & + &maxmf,maxwidth,ztop_plume - REAL, DIMENSION(IMS:IME,KMS:KME), INTENT(inout) :: & - &el_pbl + real(kind_phys), dimension(ims:ime,kms:kme), intent(inout) :: el_pbl - REAL, DIMENSION(IMS:IME,KMS:KME), optional, INTENT(out) :: & - &qwt,qshear,qbuoy,qdiss,dqke + real(kind_phys), dimension(ims:ime,kms:kme), optional, intent(inout) :: & + &qWT,qSHEAR,qBUOY,qDISS,dqke ! 3D budget arrays are not allocated when tke_budget == 0 ! 1D (local) budget arrays are used for passing between subroutines. - REAL, DIMENSION(kts:kte) :: qwt1,qshear1,qbuoy1,qdiss1, & - &dqke1,diss_heat + real(kind_phys), dimension(kts:kte) :: & + &qwt1,qshear1,qbuoy1,qdiss1,dqke1,diss_heat - REAL, DIMENSION(IMS:IME,KMS:KME), intent(out) :: Sh3D,Sm3D + real(kind_phys), dimension(ims:ime,kms:kme), intent(out) :: Sh3D,Sm3D - REAL, DIMENSION(IMS:IME,KMS:KME), INTENT(inout) :: & + real(kind_phys), dimension(ims:ime,kms:kme), intent(inout) :: & &qc_bl,qi_bl,cldfra_bl - REAL, DIMENSION(KTS:KTE) :: qc_bl1D,qi_bl1D,cldfra_bl1D,& - qc_bl1D_old,qi_bl1D_old,cldfra_bl1D_old + real(kind_phys), dimension(kts:kte) :: qc_bl1D,qi_bl1D, & + &cldfra_bl1D,qc_bl1D_old,qi_bl1D_old,cldfra_bl1D_old ! smoke/chemical arrays - INTEGER, INTENT(IN ) :: nchem, kdvel, ndvel - REAL, DIMENSION(ims:ime, kms:kme, nchem), INTENT(INOUT), optional :: chem3d - REAL, DIMENSION(ims:ime, ndvel), INTENT(IN), optional :: vdep - REAL, DIMENSION(ims:ime), INTENT(IN), optional :: frp,EMIS_ANT_NO + integer, intent(IN ) :: nchem, kdvel, ndvel + real(kind_phys), dimension(ims:ime,kms:kme,nchem), optional, intent(inout) :: chem3d + real(kind_phys), dimension(ims:ime, ndvel), optional, intent(in) :: vdep + real(kind_phys), dimension(ims:ime), optional, intent(in) :: frp,EMIS_ANT_NO !local - REAL, DIMENSION(kts:kte ,nchem) :: chem1 - REAL, DIMENSION(kts:kte+1,nchem) :: s_awchem1 - REAL, DIMENSION(ndvel) :: vd1 - INTEGER :: ic + real(kind_phys), dimension(kts:kte ,nchem) :: chem1 + real(kind_phys), dimension(kts:kte+1,nchem) :: s_awchem1 + real(kind_phys), dimension(ndvel) :: vd1 + integer :: ic !local vars - INTEGER :: ITF,JTF,KTF, IMD,JMD - INTEGER :: i,j,k,kproblem - REAL, DIMENSION(KTS:KTE) :: thl,thvl,tl,qv1,qc1,qi1,sqw,& + integer :: ITF,JTF,KTF, IMD,JMD + integer :: i,j,k,kproblem + real(kind_phys), dimension(kts:kte) :: & + &thl,tl,qv1,qc1,qi1,qs1,sqw, & &el, dfm, dfh, dfq, tcd, qcd, pdk, pdt, pdq, pdc, & - &vt, vq, sgm, thlsg, sqwsg - REAL, DIMENSION(KTS:KTE) :: thetav,sh,sm,u1,v1,w1,p1, & + &vt, vq, sgm, kzero + real(kind_phys), dimension(kts:kte) :: & + &thetav,sh,sm,u1,v1,w1,p1, & &ex1,dz1,th1,tk1,rho1,qke1,tsq1,qsq1,cov1, & - &sqv,sqi,sqc,du1,dv1,dth1,dqv1,dqc1,dqi1,ozone1, & + &sqv,sqi,sqc,sqs, & + &du1,dv1,dth1,dqv1,dqc1,dqi1,dqs1,ozone1, & &k_m1,k_h1,qni1,dqni1,qnc1,dqnc1,qnwfa1,qnifa1, & &qnbca1,dqnwfa1,dqnifa1,dqnbca1,dozone1 !mass-flux variables - REAL, DIMENSION(KTS:KTE) :: dth1mf,dqv1mf,dqc1mf,du1mf,dv1mf - REAL, DIMENSION(KTS:KTE) :: edmf_a1,edmf_w1,edmf_qt1, & - &edmf_thl1,edmf_ent1,edmf_qc1 - REAL, DIMENSION(KTS:KTE) :: edmf_a_dd1,edmf_w_dd1, & - &edmf_qt_dd1,edmf_thl_dd1, & + real(kind_phys), dimension(kts:kte) :: & + &dth1mf,dqv1mf,dqc1mf,du1mf,dv1mf + real(kind_phys), dimension(kts:kte) :: & + &edmf_a1,edmf_w1,edmf_qt1,edmf_thl1, & + &edmf_ent1,edmf_qc1 + real(kind_phys), dimension(kts:kte) :: & + &edmf_a_dd1,edmf_w_dd1,edmf_qt_dd1,edmf_thl_dd1, & &edmf_ent_dd1,edmf_qc_dd1 - REAL, DIMENSION(KTS:KTE) :: sub_thl,sub_sqv,sub_u,sub_v,& - det_thl,det_sqv,det_sqc,det_u,det_v - REAL,DIMENSION(KTS:KTE+1) :: s_aw1,s_awthl1,s_awqt1, & - s_awqv1,s_awqc1,s_awu1,s_awv1,s_awqke1, & - s_awqnc1,s_awqni1,s_awqnwfa1,s_awqnifa1, & - s_awqnbca1 - REAL,DIMENSION(KTS:KTE+1) :: sd_aw1,sd_awthl1,sd_awqt1, & - sd_awqv1,sd_awqc1,sd_awu1,sd_awv1,sd_awqke1 - - REAL, DIMENSION(KTS:KTE+1) :: zw - REAL :: cpm,sqcg,flt,fltv,flq,flqv,flqc,pmz,phh,exnerg,zet,phi_m,& - & afk,abk,ts_decay, qc_bl2, qi_bl2, & - & th_sfc,ztop_plume,sqc9,sqi9,wsp + real(kind_phys), dimension(kts:kte) :: & + &sub_thl,sub_sqv,sub_u,sub_v, & + &det_thl,det_sqv,det_sqc,det_u,det_v + real(kind_phys), dimension(kts:kte+1) :: & + &s_aw1,s_awthl1,s_awqt1, & + &s_awqv1,s_awqc1,s_awu1,s_awv1,s_awqke1, & + &s_awqnc1,s_awqni1,s_awqnwfa1,s_awqnifa1, & + &s_awqnbca1 + real(kind_phys), dimension(kts:kte+1) :: & + &sd_aw1,sd_awthl1,sd_awqt1, & + &sd_awqv1,sd_awqc1,sd_awu1,sd_awv1,sd_awqke1 + + real(kind_phys), dimension(kts:kte+1) :: zw + real(kind_phys) :: cpm,sqcg,flt,fltv,flq,flqv,flqc, & + &pmz,phh,exnerg,zet,phi_m, & + &afk,abk,ts_decay, qc_bl2, qi_bl2, & + &th_sfc,wsp !top-down diffusion - REAL, DIMENSION(ITS:ITE) :: maxKHtopdown - REAL, DIMENSION(KTS:KTE) :: KHtopdown,TKEprodTD + real(kind_phys), dimension(ITS:ITE) :: maxKHtopdown + real(kind_phys), dimension(kts:kte) :: KHtopdown,TKEprodTD - LOGICAL :: INITIALIZE_QKE,problem + logical :: INITIALIZE_QKE,problem ! Stochastic fields - INTEGER, INTENT(IN) ::spp_pbl - REAL, DIMENSION( ims:ime, kms:kme), INTENT(IN),OPTIONAL ::pattern_spp_pbl - REAL, DIMENSION(KTS:KTE) ::rstoch_col + integer, intent(in) :: spp_pbl + real(kind_phys), dimension(ims:ime,kms:kme), optional, intent(in) :: pattern_spp_pbl + real(kind_phys), dimension(kts:kte) :: rstoch_col ! Substepping TKE - INTEGER :: nsub - real :: delt2 + integer :: nsub + real(kind_phys) :: delt2 if (debug_code) then !check incoming values @@ -618,7 +617,7 @@ SUBROUTINE mynn_bl_driver( & !*** Begin debugging IMD=(IMS+IME)/2 JMD=(JMS+JME)/2 -!*** End debugging +!*** End debugging JTF=JTE ITF=ITE @@ -644,9 +643,11 @@ SUBROUTINE mynn_bl_driver( & !edmf_qc_dd(its:ite,kts:kte)=0. ENDIF ktop_plume(its:ite)=0 !int - nupdraft(its:ite)=0 !int + ztop_plume(its:ite)=0. + maxwidth(its:ite)=0. maxmf(its:ite)=0. maxKHtopdown(its:ite)=0. + kzero(kts:kte)=0. ! DH* CHECK HOW MUCH OF THIS INIT IF-BLOCK IS ACTUALLY NEEDED FOR RESTARTS !> - Within the MYNN-EDMF, there is a dependecy check for the first time step, @@ -724,7 +725,23 @@ SUBROUTINE mynn_bl_driver( & ENDIF DO i=ITS,ITF - DO k=KTS,KTE !KTF + if (FLAG_QI ) then + sqi(:)=sqi3D(i,:) + else + sqi = 0.0 + endif + if (FLAG_QS ) then + sqs(:)=sqs3D(i,:) + else + sqs = 0.0 + endif + if (icloud_bl > 0) then + cldfra_bl1d(:)=cldfra_bl(i,:) + qc_bl1d(:)=qc_bl(i,:) + qi_bl1d(:)=qi_bl(i,:) + endif + + do k=KTS,KTE !KTF dz1(k)=dz(i,k) u1(k) = u(i,k) v1(k) = v(i,k) @@ -735,52 +752,15 @@ SUBROUTINE mynn_bl_driver( & rho1(k)=rho(i,k) sqc(k)=sqc3D(i,k) !/(1.+qv(i,k)) sqv(k)=sqv3D(i,k) !/(1.+qv(i,k)) - thetav(k)=th(i,k)*(1.+0.608*sqv(k)) - IF (icloud_bl > 0) THEN - CLDFRA_BL1D(k)=CLDFRA_BL(i,k) - QC_BL1D(k)=QC_BL(i,k) - QI_BL1D(k)=QI_BL(i,k) - ENDIF - IF (FLAG_QI ) THEN - sqi(k)=sqi3D(i,k) !/(1.+qv(i,k)) - sqw(k)=sqv(k)+sqc(k)+sqi(k) - thl(k)=th1(k) - xlvcp/ex1(k)*sqc(k) & - & - xlscp/ex1(k)*sqi(k) - !Use form from Tripoli and Cotton (1981) with their - !suggested min temperature to improve accuracy. - !thl(k)=th(i,k)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k) & - ! & - xlscp/MAX(tk1(k),TKmin)*sqi(k)) - !COMPUTE THL USING SGS CLOUDS FOR PBLH DIAG - IF(sqc(k)<1e-6 .and. sqi(k)<1e-8 .and. CLDFRA_BL1D(k)>0.001)THEN - sqc9=QC_BL1D(k)*CLDFRA_BL1D(k) - sqi9=QI_BL1D(k)*CLDFRA_BL1D(k) - ELSE - sqc9=sqc(k) - sqi9=sqi(k) - ENDIF - thlsg(k)=th1(k) - xlvcp/ex1(k)*sqc9 & - & - xlscp/ex1(k)*sqi9 - sqwsg(k)=sqv(k)+sqc9+sqi9 - ELSE - sqi(k)=0.0 - sqw(k)=sqv(k)+sqc(k) - thl(k)=th1(k)-xlvcp/ex1(k)*sqc(k) - !Use form from Tripoli and Cotton (1981) with their - !suggested min temperature to improve accuracy. - !thl(k)=th(i,k)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k)) - !COMPUTE THL USING SGS CLOUDS FOR PBLH DIAG - IF(sqc(k)<1e-6 .and. CLDFRA_BL1D(k)>0.001)THEN - sqc9=QC_BL1D(k)*CLDFRA_BL1D(k) - sqi9=0.0 - ELSE - sqc9=sqc(k) - sqi9=0.0 - ENDIF - thlsg(k)=th1(k) - xlvcp/ex1(k)*sqc9 & - & - xlscp/ex1(k)*sqi9 - sqwsg(k)=sqv(k)+sqc9+sqi9 - ENDIF - thvl(k)=thlsg(k)*(1.+0.61*sqv(k)) + thetav(k)=th(i,k)*(1.+p608*sqv(k)) + !keep snow out for now - increases ceiling bias + sqw(k)=sqv(k)+sqc(k)+sqi(k)!+sqs(k) + thl(k)=th1(k) - xlvcp/ex1(k)*sqc(k) & + & - xlscp/ex1(k)*(sqi(k))!+sqs(k)) + !Use form from Tripoli and Cotton (1981) with their + !suggested min temperature to improve accuracy. + !thl(k)=th(i,k)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k) & + ! & - xlscp/MAX(tk1(k),TKmin)*sqi(k)) IF (k==kts) THEN zw(k)=0. @@ -811,7 +791,7 @@ SUBROUTINE mynn_bl_driver( & zw(kte+1)=zw(kte)+dz(i,kte) -!> - Call get_pblh() to calculate hybrid (\f$\theta_{vli}-TKE\f$) PBL height. +!> - Call get_pblh() to calculate hybrid (\f$\theta_{v}-TKE\f$) PBL height. CALL GET_PBLH(KTS,KTE,PBLH(i),thetav,& & Qke1,zw,dz1,xland(i),KPBL(i)) @@ -833,7 +813,6 @@ SUBROUTINE mynn_bl_driver( & &kts,kte,xland(i), & &dz1, dx(i), zw, & &u1, v1, thl, sqv, & - &thlsg, sqwsg, & &PBLH(i), th1, thetav, sh, sm, & &ust(i), rmol(i), & &el, Qke1, Tsq1, Qsq1, Cov1, & @@ -841,7 +820,7 @@ SUBROUTINE mynn_bl_driver( & &bl_mynn_mixlength, & &edmf_w1,edmf_a1, & &INITIALIZE_QKE, & - &spp_pbl,rstoch_col ) + &spp_pbl,rstoch_col ) IF (.not.restart) THEN !UPDATE 3D VARIABLES @@ -884,647 +863,580 @@ SUBROUTINE mynn_bl_driver( & ENDIF DO i=ITS,ITF - DO k=KTS,KTE !KTF - !JOE-TKE BUDGET - IF (tke_budget .eq. 1) THEN - dqke(i,k)=qke(i,k) - END IF - IF (icloud_bl > 0) THEN - CLDFRA_BL1D(k)=CLDFRA_BL(i,k) - QC_BL1D(k)=QC_BL(i,k) - QI_BL1D(k)=QI_BL(i,k) - cldfra_bl1D_old(k)=cldfra_bl(i,k) - qc_bl1D_old(k)=qc_bl(i,k) - qi_bl1D_old(k)=qi_bl(i,k) - else - CLDFRA_BL1D(k)=0.0 - QC_BL1D(k)=0.0 - QI_BL1D(k)=0.0 - cldfra_bl1D_old(k)=0.0 - qc_bl1D_old(k)=0.0 - qi_bl1D_old(k)=0.0 - ENDIF - dz1(k)= dz(i,k) - u1(k) = u(i,k) - v1(k) = v(i,k) - w1(k) = w(i,k) - th1(k)= th(i,k) - tk1(k)=T3D(i,k) - p1(k) = p(i,k) - ex1(k)= exner(i,k) - rho1(k)=rho(i,k) - sqv(k)= sqv3D(i,k) !/(1.+qv(i,k)) - sqc(k)= sqc3D(i,k) !/(1.+qv(i,k)) - qv1(k)= sqv(k)/(1.-sqv(k)) - qc1(k)= sqc(k)/(1.-sqv(k)) - dqc1(k)=0.0 - dqi1(k)=0.0 - dqni1(k)=0.0 - dqnc1(k)=0.0 - dqnwfa1(k)=0.0 - dqnifa1(k)=0.0 - dqnbca1(k)=0.0 - dozone1(k)=0.0 - IF(FLAG_QI)THEN - sqi(k)= sqi3D(i,k) !/(1.+qv(i,k)) - qi1(k)= sqi(k)/(1.-sqv(k)) - sqw(k)= sqv(k)+sqc(k)+sqi(k) - thl(k)= th1(k) - xlvcp/ex1(k)*sqc(k) & - & - xlscp/ex1(k)*sqi(k) - !Use form from Tripoli and Cotton (1981) with their - !suggested min temperature to improve accuracy. - !thl(k)=th(i,k)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k) & - ! & - xlscp/MAX(tk1(k),TKmin)*sqi(k)) - !COMPUTE THL USING SGS CLOUDS FOR PBLH DIAG - IF(sqc(k)<1e-6 .and. sqi(k)<1e-8 .and. CLDFRA_BL1D(k)>0.001)THEN - sqc9=QC_BL1D(k)*CLDFRA_BL1D(k) - sqi9=QI_BL1D(k)*CLDFRA_BL1D(k) - ELSE - sqc9=sqc(k) - sqi9=sqi(k) - ENDIF - thlsg(k)=th1(k) - xlvcp/ex1(k)*sqc9 & - & - xlscp/ex1(k)*sqi9 - sqwsg(k)=sqv(k)+sqc9+sqi9 - ELSE - qi1(k)=0.0 - sqi(k)=0.0 - sqw(k)= sqv(k)+sqc(k) - thl(k)= th1(k)-xlvcp/ex1(k)*sqc(k) - !Use form from Tripoli and Cotton (1981) with their - !suggested min temperature to improve accuracy. - !thl(k)=th(i,k)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k)) - !COMPUTE THL USING SGS CLOUDS FOR PBLH DIAG - IF(sqc(k)<1e-6 .and. CLDFRA_BL1D(k)>0.001)THEN - sqc9=QC_BL1D(k)*CLDFRA_BL1D(k) - sqi9=QI_BL1D(k)*CLDFRA_BL1D(k) - ELSE - sqc9=sqc(k) - sqi9=0.0 - ENDIF - thlsg(k)=th1(k) - xlvcp/ex1(k)*sqc9 & - & - xlscp/ex1(k)*sqi9 - ENDIF - thetav(k)=th1(k)*(1.+0.608*sqv(k)) - thvl(k) =thlsg(k) *(1.+0.608*sqv(k)) - - IF (FLAG_QNI ) THEN - qni1(k)=qni(i,k) - ELSE - qni1(k)=0.0 - ENDIF - IF (FLAG_QNC ) THEN - qnc1(k)=qnc(i,k) - ELSE - qnc1(k)=0.0 - ENDIF - IF (FLAG_QNWFA ) THEN - qnwfa1(k)=qnwfa(i,k) - ELSE - qnwfa1(k)=0.0 - ENDIF - IF (FLAG_QNIFA ) THEN - qnifa1(k)=qnifa(i,k) - ELSE - qnifa1(k)=0.0 - ENDIF - IF (FLAG_QNBCA .and. PRESENT(qnbca)) THEN - qnbca1(k)=qnbca(i,k) - ELSE - qnbca1(k)=0.0 - ENDIF - IF (PRESENT(ozone)) THEN - ozone1(k)=ozone(i,k) - ELSE - ozone1(k)=0.0 - ENDIF - el(k) = el_pbl(i,k) - qke1(k)=qke(i,k) - sh(k) =sh3d(i,k) - sm(k) =sm3d(i,k) - tsq1(k)=tsq(i,k) - qsq1(k)=qsq(i,k) - cov1(k)=cov(i,k) - if (spp_pbl==1) then - rstoch_col(k)=pattern_spp_pbl(i,k) - else - rstoch_col(k)=0.0 - endif - - !edmf - edmf_a1(k)=0.0 - edmf_w1(k)=0.0 - edmf_qc1(k)=0.0 - s_aw1(k)=0. - s_awthl1(k)=0. - s_awqt1(k)=0. - s_awqv1(k)=0. - s_awqc1(k)=0. - s_awu1(k)=0. - s_awv1(k)=0. - s_awqke1(k)=0. - s_awqnc1(k)=0. - s_awqni1(k)=0. - s_awqnwfa1(k)=0. - s_awqnifa1(k)=0. - s_awqnbca1(k)=0. - ![EWDD] - edmf_a_dd1(k)=0.0 - edmf_w_dd1(k)=0.0 - edmf_qc_dd1(k)=0.0 - sd_aw1(k)=0. - sd_awthl1(k)=0. - sd_awqt1(k)=0. - sd_awqv1(k)=0. - sd_awqc1(k)=0. - sd_awu1(k)=0. - sd_awv1(k)=0. - sd_awqke1(k)=0. - sub_thl(k)=0. - sub_sqv(k)=0. - sub_u(k)=0. - sub_v(k)=0. - det_thl(k)=0. - det_sqv(k)=0. - det_sqc(k)=0. - det_u(k)=0. - det_v(k)=0. - - IF (k==kts) THEN - zw(k)=0. - ELSE - zw(k)=zw(k-1)+dz(i,k-1) - ENDIF - ENDDO ! end k - - !initialize smoke/chem arrays (if used): - if ( mix_chem ) then - do ic = 1,ndvel - vd1(ic) = vdep(i,ic) ! dry deposition velocity - enddo - do k = kts,kte - do ic = 1,nchem - chem1(k,ic) = chem3d(i,k,ic) - s_awchem1(k,ic)=0. - enddo - enddo - else - do ic = 1,ndvel - vd1(ic) = 0. ! dry deposition velocity - enddo - do k = kts,kte - do ic = 1,nchem - chem1(k,ic) = 0. - s_awchem1(k,ic)=0. - enddo - enddo - endif - - zw(kte+1)=zw(kte)+dz(i,kte) - !EDMF - s_aw1(kte+1)=0. - s_awthl1(kte+1)=0. - s_awqt1(kte+1)=0. - s_awqv1(kte+1)=0. - s_awqc1(kte+1)=0. - s_awu1(kte+1)=0. - s_awv1(kte+1)=0. - s_awqke1(kte+1)=0. - s_awqnc1(kte+1)=0. - s_awqni1(kte+1)=0. - s_awqnwfa1(kte+1)=0. - s_awqnifa1(kte+1)=0. - s_awqnbca1(kte+1)=0. - sd_aw1(kte+1)=0. - sd_awthl1(kte+1)=0. - sd_awqt1(kte+1)=0. - sd_awqv1(kte+1)=0. - sd_awqc1(kte+1)=0. - sd_awu1(kte+1)=0. - sd_awv1(kte+1)=0. - sd_awqke1(kte+1)=0. - IF ( mix_chem ) THEN - DO ic = 1,nchem - s_awchem1(kte+1,ic)=0. - ENDDO - ENDIF + !Initialize some arrays + if (tke_budget .eq. 1) then + dqke(i,:)=qke(i,:) + endif + if (FLAG_QI ) then + sqi(:)=sqi3D(i,:) + else + sqi = 0.0 + endif + if (FLAG_QS ) then + sqs(:)=sqs3D(i,:) + else + sqs = 0.0 + endif + if (icloud_bl > 0) then + CLDFRA_BL1D(:)=CLDFRA_BL(i,:) + QC_BL1D(:) =QC_BL(i,:) + QI_BL1D(:) =QI_BL(i,:) + cldfra_bl1D_old(:)=cldfra_bl(i,:) + qc_bl1D_old(:)=qc_bl(i,:) + qi_bl1D_old(:)=qi_bl(i,:) + else + CLDFRA_BL1D =0.0 + QC_BL1D =0.0 + QI_BL1D =0.0 + cldfra_bl1D_old=0.0 + qc_bl1D_old =0.0 + qi_bl1D_old =0.0 + endif + dz1(kts:kte) =dz(i,kts:kte) + u1(kts:kte) =u(i,kts:kte) + v1(kts:kte) =v(i,kts:kte) + w1(kts:kte) =w(i,kts:kte) + th1(kts:kte) =th(i,kts:kte) + tk1(kts:kte) =T3D(i,kts:kte) + p1(kts:kte) =p(i,kts:kte) + ex1(kts:kte) =exner(i,kts:kte) + rho1(kts:kte) =rho(i,kts:kte) + sqv(kts:kte) =sqv3D(i,kts:kte) !/(1.+qv(i,kts:kte)) + sqc(kts:kte) =sqc3D(i,kts:kte) !/(1.+qv(i,kts:kte)) + qv1(kts:kte) =sqv(kts:kte)/(1.-sqv(kts:kte)) + qc1(kts:kte) =sqc(kts:kte)/(1.-sqv(kts:kte)) + qi1(kts:kte) =sqi(kts:kte)/(1.-sqv(kts:kte)) + qs1(kts:kte) =sqs(kts:kte)/(1.-sqv(kts:kte)) + dqc1(kts:kte) =0.0 + dqi1(kts:kte) =0.0 + dqs1(kts:kte) =0.0 + dqni1(kts:kte) =0.0 + dqnc1(kts:kte) =0.0 + dqnwfa1(kts:kte)=0.0 + dqnifa1(kts:kte)=0.0 + dqnbca1(kts:kte)=0.0 + dozone1(kts:kte)=0.0 + IF (FLAG_QNI ) THEN + qni1(kts:kte)=qni(i,kts:kte) + ELSE + qni1(kts:kte)=0.0 + ENDIF + IF (FLAG_QNC ) THEN + qnc1(kts:kte)=qnc(i,kts:kte) + ELSE + qnc1(kts:kte)=0.0 + ENDIF + IF (FLAG_QNWFA ) THEN + qnwfa1(kts:kte)=qnwfa(i,kts:kte) + ELSE + qnwfa1(kts:kte)=0.0 + ENDIF + IF (FLAG_QNIFA ) THEN + qnifa1(kts:kte)=qnifa(i,kts:kte) + ELSE + qnifa1(kts:kte)=0.0 + ENDIF + IF (FLAG_QNBCA ) THEN + qnbca1(kts:kte)=qnbca(i,kts:kte) + ELSE + qnbca1(kts:kte)=0.0 + ENDIF + IF (FLAG_OZONE ) THEN + ozone1(kts:kte)=ozone(i,kts:kte) + ELSE + ozone1(kts:kte)=0.0 + ENDIF + el(kts:kte) =el_pbl(i,kts:kte) + qke1(kts:kte)=qke(i,kts:kte) + sh(kts:kte) =sh3d(i,kts:kte) + sm(kts:kte) =sm3d(i,kts:kte) + tsq1(kts:kte)=tsq(i,kts:kte) + qsq1(kts:kte)=qsq(i,kts:kte) + cov1(kts:kte)=cov(i,kts:kte) + if (spp_pbl==1) then + rstoch_col(kts:kte)=pattern_spp_pbl(i,kts:kte) + else + rstoch_col(kts:kte)=0.0 + endif + !edmf + edmf_a1 =0.0 + edmf_w1 =0.0 + edmf_qc1 =0.0 + s_aw1 =0.0 + s_awthl1 =0.0 + s_awqt1 =0.0 + s_awqv1 =0.0 + s_awqc1 =0.0 + s_awu1 =0.0 + s_awv1 =0.0 + s_awqke1 =0.0 + s_awqnc1 =0.0 + s_awqni1 =0.0 + s_awqnwfa1 =0.0 + s_awqnifa1 =0.0 + s_awqnbca1 =0.0 + ![EWDD] + edmf_a_dd1 =0.0 + edmf_w_dd1 =0.0 + edmf_qc_dd1=0.0 + sd_aw1 =0.0 + sd_awthl1 =0.0 + sd_awqt1 =0.0 + sd_awqv1 =0.0 + sd_awqc1 =0.0 + sd_awu1 =0.0 + sd_awv1 =0.0 + sd_awqke1 =0.0 + sub_thl =0.0 + sub_sqv =0.0 + sub_u =0.0 + sub_v =0.0 + det_thl =0.0 + det_sqv =0.0 + det_sqc =0.0 + det_u =0.0 + det_v =0.0 + + do k = kts,kte + if (k==kts) then + zw(k)=0. + else + zw(k)=zw(k-1)+dz(i,k-1) + endif + !keep snow out for now - increases ceiling bias + sqw(k)= sqv(k)+sqc(k)+sqi(k)!+sqs(k) + thl(k)= th1(k) - xlvcp/ex1(k)*sqc(k) & + & - xlscp/ex1(k)*(sqi(k))!+sqs(k)) + !Use form from Tripoli and Cotton (1981) with their + !suggested min temperature to improve accuracy. + !thl(k)=th(i,k)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k) & + ! & - xlscp/MAX(tk1(k),TKmin)*sqi(k)) + thetav(k)=th1(k)*(1.+p608*sqv(k)) + enddo ! end k + zw(kte+1)=zw(kte)+dz(i,kte) + + !initialize smoke/chem arrays (if used): + if ( mix_chem ) then + do ic = 1,ndvel + vd1(ic) = vdep(i,ic) ! dry deposition velocity + enddo + do k = kts,kte + do ic = 1,nchem + chem1(k,ic) = chem3d(i,k,ic) + enddo + enddo + else + do ic = 1,ndvel + vd1(ic) = 0. ! dry deposition velocity + enddo + do k = kts,kte + do ic = 1,nchem + chem1(k,ic) = 0. + enddo + enddo + endif + s_awchem1(kts:kte+1,1:nchem) = 0.0 -!> - Call get_pblh() to calculate the hybrid \f$\theta_{vli}-TKE\f$ +!> - Call get_pblh() to calculate the hybrid \f$\theta_{v}-TKE\f$ !! PBL height diagnostic. - CALL GET_PBLH(KTS,KTE,PBLH(i),thetav,& - & Qke1,zw,dz1,xland(i),KPBL(i)) + CALL GET_PBLH(KTS,KTE,PBLH(i),thetav,& + & Qke1,zw,dz1,xland(i),KPBL(i)) !> - Call scale_aware() to calculate the similarity functions, !! \f$P_{\sigma-PBL}\f$ and \f$P_{\sigma-shcu}\f$, to control !! the scale-adaptive behaviour for the local and nonlocal !! components, respectively. - IF (scaleaware > 0.) THEN - CALL SCALE_AWARE(dx(i),PBLH(i),Psig_bl(i),Psig_shcu(i)) - ELSE - Psig_bl(i)=1.0 - Psig_shcu(i)=1.0 - ENDIF + if (scaleaware > 0.) then + call SCALE_AWARE(dx(i),PBLH(i),Psig_bl(i),Psig_shcu(i)) + else + Psig_bl(i)=1.0 + Psig_shcu(i)=1.0 + endif - sqcg= 0.0 !ill-defined variable; qcg has been removed - cpm=cp*(1.+0.84*qv1(kts)) - exnerg=(ps(i)/p1000mb)**rcp - - !----------------------------------------------------- - !ORIGINAL CODE - !flt = hfx(i)/( rho(i,kts)*cpm ) & - ! +xlvcp*ch(i)*(sqc(kts)/exner(i,kts) -sqcg/exnerg) - !flq = qfx(i)/ rho(i,kts) & - ! -ch(i)*(sqc(kts) -sqcg ) - !----------------------------------------------------- - flqv = qfx(i)/rho1(kts) - flqc = 0.0 !currently no sea-spray fluxes, fog settling hangled elsewhere - th_sfc = ts(i)/ex1(kts) - - ! TURBULENT FLUX FOR TKE BOUNDARY CONDITIONS - flq =flqv+flqc !! LATENT - flt =hfx(i)/(rho1(kts)*cpm )-xlvcp*flqc/ex1(kts) !! Temperature flux - fltv=flt + flqv*p608*th_sfc !! Virtual temperature flux - - ! Update 1/L using updated sfc heat flux and friction velocity - rmol(i) = -karman*gtr*fltv/max(ust(i)**3,1.0e-6) - zet = 0.5*dz(i,kts)*rmol(i) - zet = MAX(zet, -20.) - zet = MIN(zet, 20.) - !if(i.eq.idbg)print*,"updated z/L=",zet - if (bl_mynn_stfunc == 0) then - !Original Kansas-type stability functions - if ( zet >= 0.0 ) then - pmz = 1.0 + (cphm_st-1.0) * zet - phh = 1.0 + cphh_st * zet - else - pmz = 1.0/ (1.0-cphm_unst*zet)**0.25 - zet - phh = 1.0/SQRT(1.0-cphh_unst*zet) - end if + sqcg= 0.0 !ill-defined variable; qcg has been removed + cpm=cp*(1.+0.84*qv1(kts)) + exnerg=(ps(i)/p1000mb)**rcp + + !----------------------------------------------------- + !ORIGINAL CODE + !flt = hfx(i)/( rho(i,kts)*cpm ) & + ! +xlvcp*ch(i)*(sqc(kts)/exner(i,kts) -sqcg/exnerg) + !flq = qfx(i)/ rho(i,kts) & + ! -ch(i)*(sqc(kts) -sqcg ) + !----------------------------------------------------- + flqv = qfx(i)/rho1(kts) + flqc = 0.0 !currently no sea-spray fluxes, fog settling handled elsewhere + th_sfc = ts(i)/ex1(kts) + + ! TURBULENT FLUX FOR TKE BOUNDARY CONDITIONS + flq =flqv+flqc !! LATENT + flt =hfx(i)/(rho1(kts)*cpm )-xlvcp*flqc/ex1(kts) !! Temperature flux + fltv=flt + flqv*p608*th_sfc !! Virtual temperature flux + + ! Update 1/L using updated sfc heat flux and friction velocity + rmol(i) = -karman*gtr*fltv/max(ust(i)**3,1.0e-6) + zet = 0.5*dz(i,kts)*rmol(i) + zet = MAX(zet, -20.) + zet = MIN(zet, 20.) + !if(i.eq.idbg)print*,"updated z/L=",zet + if (bl_mynn_stfunc == 0) then + !Original Kansas-type stability functions + if ( zet >= 0.0 ) then + pmz = 1.0 + (cphm_st-1.0) * zet + phh = 1.0 + cphh_st * zet else - !Updated stability functions (Puhales, 2020) - phi_m = phim(zet) - pmz = phi_m - zet - phh = phih(zet) + pmz = 1.0/ (1.0-cphm_unst*zet)**0.25 - zet + phh = 1.0/SQRT(1.0-cphh_unst*zet) end if + else + !Updated stability functions (Puhales, 2020) + phi_m = phim(zet) + pmz = phi_m - zet + phh = phih(zet) + end if !> - Call mym_condensation() to calculate the nonconvective component !! of the subgrid cloud fraction and mixing ratio as well as the functions !! used to calculate the buoyancy flux. Different cloud PDFs can be !! selected by use of the namelist parameter \p bl_mynn_cloudpdf. - CALL mym_condensation ( kts,kte, & - &dx(i),dz1,zw,xland(i), & - &thl,sqw,sqv,sqc,sqi, & - &p1,ex1,tsq1,qsq1,cov1, & - &Sh,el,bl_mynn_cloudpdf, & - &qc_bl1D,qi_bl1D,cldfra_bl1D, & - &PBLH(i),HFX(i), & - &Vt, Vq, th1, sgm, rmol(i), & - &spp_pbl, rstoch_col ) + call mym_condensation (kts,kte, & + &dx(i),dz1,zw,xland(i), & + &thl,sqw,sqv,sqc,sqi,sqs, & + &p1,ex1,tsq1,qsq1,cov1, & + &Sh,el,bl_mynn_cloudpdf, & + &qc_bl1D,qi_bl1D,cldfra_bl1D, & + &PBLH(i),HFX(i), & + &Vt, Vq, th1, sgm, rmol(i), & + &spp_pbl, rstoch_col ) !> - Add TKE source driven by cloud top cooling !! Calculate the buoyancy production of TKE from cloud-top cooling when !! \p bl_mynn_topdown =1. - IF (bl_mynn_topdown.eq.1)then - CALL topdown_cloudrad(kts,kte,dz1,zw, & - &xland(i),kpbl(i),PBLH(i), & - &sqc,sqi,sqw,thl,th1,ex1,p1,rho1,thetav, & - &cldfra_bl1D,rthraten(i,:), & - &maxKHtopdown(i),KHtopdown,TKEprodTD ) - ELSE - maxKHtopdown(i) = 0.0 - KHtopdown(kts:kte) = 0.0 - TKEprodTD(kts:kte) = 0.0 - ENDIF + if (bl_mynn_topdown.eq.1) then + call topdown_cloudrad(kts,kte,dz1,zw, & + &xland(i),kpbl(i),PBLH(i), & + &sqc,sqi,sqw,thl,th1,ex1,p1,rho1,thetav, & + &cldfra_bl1D,rthraten(i,:), & + &maxKHtopdown(i),KHtopdown,TKEprodTD ) + else + maxKHtopdown(i) = 0.0 + KHtopdown(kts:kte) = 0.0 + TKEprodTD(kts:kte) = 0.0 + endif - IF (bl_mynn_edmf > 0) THEN - !PRINT*,"Calling DMP Mass-Flux: i= ",i - CALL DMP_mf( & - &kts,kte,delt,zw,dz1,p1,rho1, & - &bl_mynn_edmf_mom, & - &bl_mynn_edmf_tke, & - &bl_mynn_mixscalars, & - &u1,v1,w1,th1,thl,thetav,tk1, & - &sqw,sqv,sqc,qke1, & - &qnc1,qni1,qnwfa1,qnifa1,qnbca1, & - &ex1,Vt,Vq,sgm, & - &ust(i),flt,fltv,flq,flqv, & - &PBLH(i),KPBL(i),DX(i), & - &xland(i),th_sfc, & + if (bl_mynn_edmf > 0) then + !PRINT*,"Calling DMP Mass-Flux: i= ",i + call DMP_mf( & + &kts,kte,delt,zw,dz1,p1,rho1, & + &bl_mynn_edmf_mom, & + &bl_mynn_edmf_tke, & + &bl_mynn_mixscalars, & + &u1,v1,w1,th1,thl,thetav,tk1, & + &sqw,sqv,sqc,qke1, & + &qnc1,qni1,qnwfa1,qnifa1,qnbca1, & + &ex1,Vt,Vq,sgm, & + &ust(i),flt,fltv,flq,flqv, & + &PBLH(i),KPBL(i),DX(i), & + &xland(i),th_sfc, & ! now outputs - tendencies - ! &,dth1mf,dqv1mf,dqc1mf,du1mf,dv1mf & + ! &,dth1mf,dqv1mf,dqc1mf,du1mf,dv1mf & ! outputs - updraft properties - & edmf_a1,edmf_w1,edmf_qt1, & - & edmf_thl1,edmf_ent1,edmf_qc1, & + &edmf_a1,edmf_w1,edmf_qt1, & + &edmf_thl1,edmf_ent1,edmf_qc1, & ! for the solver - & s_aw1,s_awthl1,s_awqt1, & - & s_awqv1,s_awqc1, & - & s_awu1,s_awv1,s_awqke1, & - & s_awqnc1,s_awqni1, & - & s_awqnwfa1,s_awqnifa1,s_awqnbca1,& - & sub_thl,sub_sqv, & - & sub_u,sub_v, & - & det_thl,det_sqv,det_sqc, & - & det_u,det_v, & + &s_aw1,s_awthl1,s_awqt1, & + &s_awqv1,s_awqc1, & + &s_awu1,s_awv1,s_awqke1, & + &s_awqnc1,s_awqni1, & + &s_awqnwfa1,s_awqnifa1,s_awqnbca1, & + &sub_thl,sub_sqv, & + &sub_u,sub_v, & + &det_thl,det_sqv,det_sqc, & + &det_u,det_v, & ! chem/smoke mixing - & nchem,chem1,s_awchem1, & - & mix_chem, & - & qc_bl1D,cldfra_bl1D, & - & qc_bl1D_old,cldfra_bl1D_old, & - & FLAG_QC,FLAG_QI, & - & FLAG_QNC,FLAG_QNI, & - & FLAG_QNWFA,FLAG_QNIFA,FLAG_QNBCA,& - & Psig_shcu(i), & - & nupdraft(i),ktop_plume(i), & - & maxmf(i),ztop_plume, & - & spp_pbl,rstoch_col ) - ENDIF + &nchem,chem1,s_awchem1, & + &mix_chem, & + &qc_bl1D,cldfra_bl1D, & + &qc_bl1D_old,cldfra_bl1D_old, & + &FLAG_QC,FLAG_QI, & + &FLAG_QNC,FLAG_QNI, & + &FLAG_QNWFA,FLAG_QNIFA,FLAG_QNBCA, & + &Psig_shcu(i), & + &maxwidth(i),ktop_plume(i), & + &maxmf(i),ztop_plume(i), & + &spp_pbl,rstoch_col ) + endif - IF (bl_mynn_edmf_dd == 1) THEN - CALL DDMF_JPL(kts,kte,delt,zw,dz1,p1, & - &u1,v1,th1,thl,thetav,tk1, & - sqw,sqv,sqc,rho1,ex1, & - &ust(i),flt,flq, & - &PBLH(i),KPBL(i), & - &edmf_a_dd1,edmf_w_dd1,edmf_qt_dd1, & - &edmf_thl_dd1,edmf_ent_dd1, & - &edmf_qc_dd1, & - &sd_aw1,sd_awthl1,sd_awqt1, & - &sd_awqv1,sd_awqc1,sd_awu1,sd_awv1, & - &sd_awqke1, & - &qc_bl1d,cldfra_bl1d, & - &rthraten(i,:) ) - ENDIF + if (bl_mynn_edmf_dd == 1) then + call DDMF_JPL(kts,kte,delt,zw,dz1,p1, & + &u1,v1,th1,thl,thetav,tk1, & + &sqw,sqv,sqc,rho1,ex1, & + &ust(i),flt,flq, & + &PBLH(i),KPBL(i), & + &edmf_a_dd1,edmf_w_dd1,edmf_qt_dd1, & + &edmf_thl_dd1,edmf_ent_dd1, & + &edmf_qc_dd1, & + &sd_aw1,sd_awthl1,sd_awqt1, & + &sd_awqv1,sd_awqc1,sd_awu1,sd_awv1, & + &sd_awqke1, & + &qc_bl1d,cldfra_bl1d, & + &rthraten(i,:) ) + endif - !Capability to substep the eddy-diffusivity portion - !do nsub = 1,2 - delt2 = delt !*0.5 !only works if topdown=0 - - CALL mym_turbulence ( & - &kts,kte,xland(i),closure, & - &dz1, DX(i), zw, & - &u1, v1, thl, thetav, sqc, sqw, & - &thlsg, sqwsg, & - &qke1, tsq1, qsq1, cov1, & - &vt, vq, & - &rmol(i), flt, flq, & - &PBLH(i),th1, & - &Sh,Sm,el, & - &Dfm,Dfh,Dfq, & - &Tcd,Qcd,Pdk, & - &Pdt,Pdq,Pdc, & - &qWT1,qSHEAR1,qBUOY1,qDISS1, & - &tke_budget, & - &Psig_bl(i),Psig_shcu(i), & - &cldfra_bl1D,bl_mynn_mixlength, & - &edmf_w1,edmf_a1, & - &TKEprodTD, & - &spp_pbl,rstoch_col) + !Capability to substep the eddy-diffusivity portion + !do nsub = 1,2 + delt2 = delt !*0.5 !only works if topdown=0 + + call mym_turbulence( & + &kts,kte,xland(i),closure, & + &dz1, DX(i), zw, & + &u1, v1, thl, thetav, sqc, sqw, & + &qke1, tsq1, qsq1, cov1, & + &vt, vq, & + &rmol(i), flt, fltv, flq, & + &PBLH(i),th1, & + &Sh,Sm,el, & + &Dfm,Dfh,Dfq, & + &Tcd,Qcd,Pdk, & + &Pdt,Pdq,Pdc, & + &qWT1,qSHEAR1,qBUOY1,qDISS1, & + &tke_budget, & + &Psig_bl(i),Psig_shcu(i), & + &cldfra_bl1D,bl_mynn_mixlength, & + &edmf_w1,edmf_a1, & + &TKEprodTD, & + &spp_pbl,rstoch_col ) !> - Call mym_predict() to solve TKE and !! \f$\theta^{'2}, q^{'2}, and \theta^{'}q^{'}\f$ !! for the following time step. - CALL mym_predict (kts,kte,closure, & - &delt2, dz1, & - &ust(i), flt, flq, pmz, phh, & - &el, dfq, rho1, pdk, pdt, pdq, pdc,& - &Qke1, Tsq1, Qsq1, Cov1, & - &s_aw1, s_awqke1, bl_mynn_edmf_tke,& - &qWT1, qDISS1,tke_budget ) !! TKE budget (Puhales, 2020) - - if (dheat_opt > 0) then - DO k=kts,kte-1 - ! Set max dissipative heating rate to 7.2 K per hour - diss_heat(k) = MIN(MAX(1.0*(qke1(k)**1.5)/(b1*MAX(0.5*(el(k)+el(k+1)),1.))/cp, 0.0),0.002) - ! Limit heating above 100 mb: - diss_heat(k) = diss_heat(k) * exp(-10000./MAX(p1(k),1.)) - ENDDO - diss_heat(kte) = 0. - else - diss_heat(1:kte) = 0. - endif + call mym_predict(kts,kte,closure, & + &delt2, dz1, & + &ust(i), flt, flq, pmz, phh, & + &el, dfq, rho1, pdk, pdt, pdq, pdc, & + &Qke1, Tsq1, Qsq1, Cov1, & + &s_aw1, s_awqke1, bl_mynn_edmf_tke, & + &qWT1, qDISS1, tke_budget ) + + if (dheat_opt > 0) then + do k=kts,kte-1 + ! Set max dissipative heating rate to 7.2 K per hour + diss_heat(k) = MIN(MAX(1.0*(qke1(k)**1.5)/(b1*MAX(0.5*(el(k)+el(k+1)),1.))/cp, 0.0),0.002) + ! Limit heating above 100 mb: + diss_heat(k) = diss_heat(k) * exp(-10000./MAX(p1(k),1.)) + enddo + diss_heat(kte) = 0. + else + diss_heat(1:kte) = 0. + endif !> - Call mynn_tendencies() to solve for tendencies of !! \f$U, V, \theta, q_{v}, q_{c}, and q_{i}\f$. - CALL mynn_tendencies(kts,kte,i, & - &delt, dz1, rho1, & - &u1, v1, th1, tk1, qv1, & - &qc1, qi1, qnc1, qni1, & - &ps(i), p1, ex1, thl, & - &sqv, sqc, sqi, sqw, & - &qnwfa1, qnifa1, qnbca1, ozone1, & - &ust(i),flt,flq,flqv,flqc, & - &wspd(i),uoce(i),voce(i), & - &tsq1, qsq1, cov1, & - &tcd, qcd, & - &dfm, dfh, dfq, & - &Du1, Dv1, Dth1, Dqv1, & - &Dqc1, Dqi1, Dqnc1, Dqni1, & - &Dqnwfa1, Dqnifa1, Dqnbca1, & - &Dozone1, & - &diss_heat, & + call mynn_tendencies(kts,kte,i, & + &delt, dz1, rho1, & + &u1, v1, th1, tk1, qv1, & + &qc1, qi1, kzero, qnc1, qni1, & !kzero replaces qs1 - not mixing snow + &ps(i), p1, ex1, thl, & + &sqv, sqc, sqi, kzero, sqw, & !kzero replaces sqs - not mixing snow + &qnwfa1, qnifa1, qnbca1, ozone1, & + &ust(i),flt,flq,flqv,flqc, & + &wspd(i),uoce(i),voce(i), & + &tsq1, qsq1, cov1, & + &tcd, qcd, & + &dfm, dfh, dfq, & + &Du1, Dv1, Dth1, Dqv1, & + &Dqc1, Dqi1, Dqs1, Dqnc1, Dqni1, & + &Dqnwfa1, Dqnifa1, Dqnbca1, & + &Dozone1, & + &diss_heat, & ! mass flux components - &s_aw1,s_awthl1,s_awqt1, & - &s_awqv1,s_awqc1,s_awu1,s_awv1, & - &s_awqnc1,s_awqni1, & - &s_awqnwfa1,s_awqnifa1,s_awqnbca1,& - &sd_aw1,sd_awthl1,sd_awqt1, & - &sd_awqv1,sd_awqc1, & - sd_awu1,sd_awv1, & - &sub_thl,sub_sqv, & - &sub_u,sub_v, & - &det_thl,det_sqv,det_sqc, & - &det_u,det_v, & - &FLAG_QC,FLAG_QI,FLAG_QNC, & - &FLAG_QNI,FLAG_QNWFA,FLAG_QNIFA, & - &FLAG_QNBCA, & - &cldfra_bl1d, & - &bl_mynn_cloudmix, & - &bl_mynn_mixqt, & - &bl_mynn_edmf, & - &bl_mynn_edmf_mom, & - &bl_mynn_mixscalars ) - - - IF ( mix_chem ) THEN - IF ( rrfs_sd ) THEN - CALL mynn_mix_chem(kts,kte,i, & - &delt, dz1, pblh(i), & - &nchem, kdvel, ndvel, & - &chem1, vd1, & - &rho1,flt, & - &tcd, qcd, & - &dfh, & - &s_aw1,s_awchem1, & - &emis_ant_no(i), & - &frp(i), rrfs_sd, & - &enh_mix, smoke_dbg ) - ELSE - CALL mynn_mix_chem(kts,kte,i, & - &delt, dz1, pblh(i), & - &nchem, kdvel, ndvel, & - &chem1, vd1, & - &rho1,flt, & - &tcd, qcd, & - &dfh, & - &s_aw1,s_awchem1, & - &zero, & - &zero, rrfs_sd, & - &enh_mix, smoke_dbg ) - ENDIF - DO ic = 1,nchem - DO k = kts,kte - chem3d(i,k,ic) = max(1.e-12, chem1(k,ic)) - ENDDO - ENDDO - ENDIF + &s_aw1,s_awthl1,s_awqt1, & + &s_awqv1,s_awqc1,s_awu1,s_awv1, & + &s_awqnc1,s_awqni1, & + &s_awqnwfa1,s_awqnifa1,s_awqnbca1, & + &sd_aw1,sd_awthl1,sd_awqt1, & + &sd_awqv1,sd_awqc1, & + &sd_awu1,sd_awv1, & + &sub_thl,sub_sqv, & + &sub_u,sub_v, & + &det_thl,det_sqv,det_sqc, & + &det_u,det_v, & + &FLAG_QC,FLAG_QI,FLAG_QNC, & + &FLAG_QNI,FLAG_QS, & + &FLAG_QNWFA,FLAG_QNIFA, & + &FLAG_QNBCA,FLAG_OZONE, & + &cldfra_bl1d, & + &bl_mynn_cloudmix, & + &bl_mynn_mixqt, & + &bl_mynn_edmf, & + &bl_mynn_edmf_mom, & + &bl_mynn_mixscalars ) + + + if ( mix_chem ) then + if ( rrfs_sd ) then + call mynn_mix_chem(kts,kte,i, & + &delt, dz1, pblh(i), & + &nchem, kdvel, ndvel, & + &chem1, vd1, & + &rho1,flt, & + &tcd, qcd, & + &dfh, & + &s_aw1,s_awchem1, & + &emis_ant_no(i), & + &frp(i), rrfs_sd, & + &enh_mix, smoke_dbg ) + else + call mynn_mix_chem(kts,kte,i, & + &delt, dz1, pblh(i), & + &nchem, kdvel, ndvel, & + &chem1, vd1, & + &rho1,flt, & + &tcd, qcd, & + &dfh, & + &s_aw1,s_awchem1, & + &zero, & + &zero, rrfs_sd, & + &enh_mix, smoke_dbg ) + endif + do ic = 1,nchem + do k = kts,kte + chem3d(i,k,ic) = max(1.e-12, chem1(k,ic)) + enddo + enddo + endif - CALL retrieve_exchange_coeffs(kts,kte,& - &dfm, dfh, dz1, K_m1, K_h1) - - !UPDATE 3D ARRAYS - do k=kts,kte - exch_m(i,k)=K_m1(k) - exch_h(i,k)=K_h1(k) - rublten(i,k)=du1(k) - rvblten(i,k)=dv1(k) - rthblten(i,k)=dth1(k) - rqvblten(i,k)=dqv1(k) - if (bl_mynn_cloudmix > 0) then - if (present(sqc3D) .and. flag_qc) rqcblten(i,k)=dqc1(k) - if (present(sqi3D) .and. flag_qi) rqiblten(i,k)=dqi1(k) - else - if (present(sqc3D) .and. flag_qc) rqcblten(i,k)=0. - if (present(sqi3D) .and. flag_qi) rqiblten(i,k)=0. - endif - if (bl_mynn_cloudmix > 0 .and. bl_mynn_mixscalars > 0) then - if (present(qnc) .and. flag_qnc) rqncblten(i,k)=dqnc1(k) - if (present(qni) .and. flag_qni) rqniblten(i,k)=dqni1(k) - if (present(qnwfa) .and. flag_qnwfa) rqnwfablten(i,k)=dqnwfa1(k) - if (present(qnifa) .and. flag_qnifa) rqnifablten(i,k)=dqnifa1(k) - if (present(qnbca) .and. flag_qnbca) rqnbcablten(i,k)=dqnbca1(k) - else - if (present(qnc) .and. flag_qnc) rqncblten(i,k)=0. - if (present(qni) .and. flag_qni) rqniblten(i,k)=0. - if (present(qnwfa) .and. flag_qnwfa) rqnwfablten(i,k)=0. - if (present(qnifa) .and. flag_qnifa) rqnifablten(i,k)=0. - if (present(qnbca) .and. flag_qnbca) rqnbcablten(i,k)=0. - endif - dozone(i,k)=dozone1(k) - - if (icloud_bl > 0) then - qc_bl(i,k)=qc_bl1D(k) - qi_bl(i,k)=qi_bl1D(k) - cldfra_bl(i,k)=cldfra_bl1D(k) - endif - - el_pbl(i,k)=el(k) - qke(i,k)=qke1(k) - tsq(i,k)=tsq1(k) - qsq(i,k)=qsq1(k) - cov(i,k)=cov1(k) - sh3d(i,k)=sh(k) - sm3d(i,k)=sm(k) - enddo !end-k + call retrieve_exchange_coeffs(kts,kte, & + &dfm, dfh, dz1, K_m1, K_h1 ) + + !UPDATE 3D ARRAYS + exch_m(i,kts:kte) =k_m1(kts:kte) + exch_h(i,kts:kte) =k_h1(kts:kte) + rublten(i,kts:kte) =du1(kts:kte) + rvblten(i,kts:kte) =dv1(kts:kte) + rthblten(i,kts:kte)=dth1(kts:kte) + rqvblten(i,kts:kte)=dqv1(kts:kte) + if (bl_mynn_cloudmix > 0) then + if (flag_qc) rqcblten(i,kts:kte)=dqc1(kts:kte) + if (flag_qi) rqiblten(i,kts:kte)=dqi1(kts:kte) + if (flag_qs) rqsblten(i,kts:kte)=dqs1(kts:kte) + else + if (flag_qc) rqcblten(i,:)=0. + if (flag_qi) rqiblten(i,:)=0. + if (flag_qs) rqsblten(i,:)=0. + endif + if (bl_mynn_cloudmix > 0 .and. bl_mynn_mixscalars > 0) then + if (flag_qnc) rqncblten(i,kts:kte) =dqnc1(kts:kte) + if (flag_qni) rqniblten(i,kts:kte) =dqni1(kts:kte) + if (flag_qnwfa) rqnwfablten(i,kts:kte)=dqnwfa1(kts:kte) + if (flag_qnifa) rqnifablten(i,kts:kte)=dqnifa1(kts:kte) + if (flag_qnbca) rqnbcablten(i,kts:kte)=dqnbca1(kts:kte) + else + if (flag_qnc) rqncblten(i,:) =0. + if (flag_qni) rqniblten(i,:) =0. + if (flag_qnwfa) rqnwfablten(i,:)=0. + if (flag_qnifa) rqnifablten(i,:)=0. + if (flag_qnbca) rqnbcablten(i,:)=0. + endif + dozone(i,kts:kte)=dozone1(kts:kte) + if (icloud_bl > 0) then + qc_bl(i,kts:kte) =qc_bl1D(kts:kte) + qi_bl(i,kts:kte) =qi_bl1D(kts:kte) + cldfra_bl(i,kts:kte)=cldfra_bl1D(kts:kte) + endif + el_pbl(i,kts:kte)=el(kts:kte) + qke(i,kts:kte) =qke1(kts:kte) + tsq(i,kts:kte) =tsq1(kts:kte) + qsq(i,kts:kte) =qsq1(kts:kte) + cov(i,kts:kte) =cov1(kts:kte) + sh3d(i,kts:kte) =sh(kts:kte) + sm3d(i,kts:kte) =sm(kts:kte) + + if (tke_budget .eq. 1) then + !! TKE budget is now given in m**2/s**-3 (Puhales, 2020) + !! Lower boundary condtions (using similarity relationships such as the prognostic equation for Qke) + k=kts + qSHEAR1(k) =4.*(ust(i)**3*phi_m/(karman*dz(i,k)))-qSHEAR1(k+1) !! staggered + qBUOY1(k) =4.*(-ust(i)**3*zet/(karman*dz(i,k)))-qBUOY1(k+1) !! staggered + !! unstaggering SHEAR and BUOY and trasfering all TKE budget to 3D array + do k = kts,kte-1 + qSHEAR(i,k)=0.5*(qSHEAR1(k)+qSHEAR1(k+1)) !!! unstaggering in z + qBUOY(i,k) =0.5*(qBUOY1(k)+qBUOY1(k+1)) !!! unstaggering in z + qWT(i,k) =qWT1(k) + qDISS(i,k) =qDISS1(k) + dqke(i,k) =(qke1(k)-dqke(i,k))*0.5/delt + enddo + !! Upper boundary conditions + k=kte + qSHEAR(i,k) =0. + qBUOY(i,k) =0. + qWT(i,k) =0. + qDISS(i,k) =0. + dqke(i,k) =0. + endif - if (tke_budget .eq. 1) then - !! TKE budget is now given in m**2/s**-3 (Puhales, 2020) - !! Lower boundary condtions (using similarity relationships such as the prognostic equation for Qke) - k=kts - qSHEAR1(k)=4.*(ust(i)**3*phi_m/(karman*dz(i,k)))-qSHEAR1(k+1) !! staggered - qBUOY1(k)=4.*(-ust(i)**3*zet/(karman*dz(i,k)))-qBUOY1(k+1) !! staggered - !! unstaggering SHEAR and BUOY and trasfering all TKE budget to 3D array - do k = kts,kte-1 - qSHEAR(i,k)=0.5*(qSHEAR1(k)+qSHEAR1(k+1)) !!! unstaggering in z - qBUOY(i,k)=0.5*(qBUOY1(k)+qBUOY1(k+1)) !!! unstaggering in z - qWT(i,k)=qWT1(k) - qDISS(i,k)=qDISS1(k) - dqke(i,k)=(qke1(k)-dqke(i,k))*0.5/delt - enddo - !! Upper boundary conditions - k=kte - qSHEAR(i,k)=0. - qBUOY(i,k)=0. - qWT(i,k)=0. - qDISS(i,k)=0. - dqke(i,k)=0. + !update updraft/downdraft properties + if (bl_mynn_output > 0) then !research mode == 1 + if (bl_mynn_edmf > 0) then + edmf_a(i,kts:kte) =edmf_a1(kts:kte) + edmf_w(i,kts:kte) =edmf_w1(kts:kte) + edmf_qt(i,kts:kte) =edmf_qt1(kts:kte) + edmf_thl(i,kts:kte) =edmf_thl1(kts:kte) + edmf_ent(i,kts:kte) =edmf_ent1(kts:kte) + edmf_qc(i,kts:kte) =edmf_qc1(kts:kte) + sub_thl3D(i,kts:kte)=sub_thl(kts:kte) + sub_sqv3D(i,kts:kte)=sub_sqv(kts:kte) + det_thl3D(i,kts:kte)=det_thl(kts:kte) + det_sqv3D(i,kts:kte)=det_sqv(kts:kte) endif + !if (bl_mynn_edmf_dd > 0) THEN + ! edmf_a_dd(i,kts:kte) =edmf_a_dd1(kts:kte) + ! edmf_w_dd(i,kts:kte) =edmf_w_dd1(kts:kte) + ! edmf_qt_dd(i,kts:kte) =edmf_qt_dd1(kts:kte) + ! edmf_thl_dd(i,kts:kte)=edmf_thl_dd1(kts:kte) + ! edmf_ent_dd(i,kts:kte)=edmf_ent_dd1(kts:kte) + ! edmf_qc_dd(i,kts:kte) =edmf_qc_dd1(kts:kte) + !endif + endif - !update updraft/downdraft properties - if (bl_mynn_output > 0) THEN !research mode == 1 - if (bl_mynn_edmf > 0) THEN - DO k = kts,kte - edmf_a(i,k)=edmf_a1(k) - edmf_w(i,k)=edmf_w1(k) - edmf_qt(i,k)=edmf_qt1(k) - edmf_thl(i,k)=edmf_thl1(k) - edmf_ent(i,k)=edmf_ent1(k) - edmf_qc(i,k)=edmf_qc1(k) - sub_thl3D(i,k)=sub_thl(k) - sub_sqv3D(i,k)=sub_sqv(k) - det_thl3D(i,k)=det_thl(k) - det_sqv3D(i,k)=det_sqv(k) - ENDDO - endif -! if (bl_mynn_edmf_dd > 0) THEN -! DO k = kts,kte -! edmf_a_dd(i,k)=edmf_a_dd1(k) -! edmf_w_dd(i,k)=edmf_w_dd1(k) -! edmf_qt_dd(i,k)=edmf_qt_dd1(k) -! edmf_thl_dd(i,k)=edmf_thl_dd1(k) -! edmf_ent_dd(i,k)=edmf_ent_dd1(k) -! edmf_qc_dd(i,k)=edmf_qc_dd1(k) -! ENDDO -! ENDIF - ENDIF - - !*** Begin debug prints - IF ( debug_code .and. (i .eq. idbg)) THEN - IF ( ABS(QFX(i))>.001)print*,& - "SUSPICIOUS VALUES AT: i=",i," QFX=",QFX(i) - IF ( ABS(HFX(i))>1100.)print*,& - "SUSPICIOUS VALUES AT: i=",i," HFX=",HFX(i) - DO k = kts,kte - IF ( sh(k) < 0. .OR. sh(k)> 200.)print*,& - "SUSPICIOUS VALUES AT: i,k=",i,k," sh=",sh(k) - IF ( ABS(vt(k)) > 2.0 )print*,& - "SUSPICIOUS VALUES AT: i,k=",i,k," vt=",vt(k) - IF ( ABS(vq(k)) > 7000.)print*,& - "SUSPICIOUS VALUES AT: i,k=",i,k," vq=",vq(k) - IF ( qke(i,k) < -1. .OR. qke(i,k)> 200.)print*,& - "SUSPICIOUS VALUES AT: i,k=",i,k," qke=",qke(i,k) - IF ( el_pbl(i,k) < 0. .OR. el_pbl(i,k)> 1500.)print*,& - "SUSPICIOUS VALUES AT: i,k=",i,k," el_pbl=",el_pbl(i,k) - IF ( exch_m(i,k) < 0. .OR. exch_m(i,k)> 2000.)print*,& - "SUSPICIOUS VALUES AT: i,k=",i,k," exxch_m=",exch_m(i,k) - IF (icloud_bl > 0) then - IF( cldfra_bl(i,k) < 0.0 .OR. cldfra_bl(i,k)> 1.)THEN - PRINT*,"SUSPICIOUS VALUES: CLDFRA_BL=",cldfra_bl(i,k)," qc_bl=",QC_BL(i,k) - ENDIF - ENDIF - - !IF (I==IMD .AND. J==JMD) THEN - ! PRINT*,"MYNN DRIVER END: k=",k," sh=",sh(k) - ! PRINT*," sqw=",sqw(k)," thl=",thl(k)," exch_m=",exch_m(i,k) - ! PRINT*," xland=",xland(i)," rmol=",rmol(i)," ust=",ust(i) - ! PRINT*," qke=",qke(i,k)," el=",el_pbl(i,k)," tsq=",tsq(i,k) - ! PRINT*," PBLH=",PBLH(i)," u=",u(i,k)," v=",v(i,k) - ! PRINT*," vq=",vq(k)," vt=",vt(k) - !ENDIF - ENDDO !end-k - ENDIF - !*** End debug prints + !*** Begin debug prints + if ( debug_code .and. (i .eq. idbg)) THEN + if ( ABS(QFX(i))>.001)print*,& + "SUSPICIOUS VALUES AT: i=",i," QFX=",QFX(i) + if ( ABS(HFX(i))>1100.)print*,& + "SUSPICIOUS VALUES AT: i=",i," HFX=",HFX(i) + do k = kts,kte + IF ( sh(k) < 0. .OR. sh(k)> 200.)print*,& + "SUSPICIOUS VALUES AT: i,k=",i,k," sh=",sh(k) + IF ( ABS(vt(k)) > 2.0 )print*,& + "SUSPICIOUS VALUES AT: i,k=",i,k," vt=",vt(k) + IF ( ABS(vq(k)) > 7000.)print*,& + "SUSPICIOUS VALUES AT: i,k=",i,k," vq=",vq(k) + IF ( qke(i,k) < -1. .OR. qke(i,k)> 200.)print*,& + "SUSPICIOUS VALUES AT: i,k=",i,k," qke=",qke(i,k) + IF ( el_pbl(i,k) < 0. .OR. el_pbl(i,k)> 1500.)print*,& + "SUSPICIOUS VALUES AT: i,k=",i,k," el_pbl=",el_pbl(i,k) + IF ( exch_m(i,k) < 0. .OR. exch_m(i,k)> 2000.)print*,& + "SUSPICIOUS VALUES AT: i,k=",i,k," exxch_m=",exch_m(i,k) + IF (icloud_bl > 0) then + IF ( cldfra_bl(i,k) < 0.0 .OR. cldfra_bl(i,k)> 1.)THEN + PRINT*,"SUSPICIOUS VALUES: CLDFRA_BL=",cldfra_bl(i,k)," qc_bl=",QC_BL(i,k) + ENDIF + ENDIF - !JOE-add tke_pbl for coupling w/shallow-cu schemes (TKE_PBL = QKE/2.) - ! TKE_PBL is defined on interfaces, while QKE is at middle of layer. - !tke_pbl(i,kts) = 0.5*MAX(qke(i,kts),1.0e-10) - !DO k = kts+1,kte - ! afk = dz1(k)/( dz1(k)+dz1(k-1) ) - ! abk = 1.0 -afk - ! tke_pbl(i,k) = 0.5*MAX(qke(i,k)*abk+qke(i,k-1)*afk,1.0e-3) - !ENDDO + !IF (I==IMD .AND. J==JMD) THEN + ! PRINT*,"MYNN DRIVER END: k=",k," sh=",sh(k) + ! PRINT*," sqw=",sqw(k)," thl=",thl(k)," exch_m=",exch_m(i,k) + ! PRINT*," xland=",xland(i)," rmol=",rmol(i)," ust=",ust(i) + ! PRINT*," qke=",qke(i,k)," el=",el_pbl(i,k)," tsq=",tsq(i,k) + ! PRINT*," PBLH=",PBLH(i)," u=",u(i,k)," v=",v(i,k) + ! PRINT*," vq=",vq(k)," vt=",vt(k) + !ENDIF + enddo !end-k + endif - ENDDO !end i-loop + enddo !end i-loop !ACF copy qke into qke_adv if using advection IF (bl_mynn_tkeadvect) THEN @@ -1602,7 +1514,6 @@ SUBROUTINE mym_initialize ( & & kts,kte,xland, & & dz, dx, zw, & & u, v, thl, qw, & - & thlsg, qwsg, & ! & ust, rmo, pmz, phh, flt, flq, & & zi, theta, thetav, sh, sm, & & ust, rmo, el, & @@ -1613,28 +1524,28 @@ SUBROUTINE mym_initialize ( & & spp_pbl,rstoch_col) ! !------------------------------------------------------------------- - - INTEGER, INTENT(IN) :: kts,kte - INTEGER, INTENT(IN) :: bl_mynn_mixlength - LOGICAL, INTENT(IN) :: INITIALIZE_QKE -! REAL, INTENT(IN) :: ust, rmo, pmz, phh, flt, flq - REAL, INTENT(IN) :: ust, rmo, Psig_bl, dx, xland - REAL, DIMENSION(kts:kte), INTENT(in) :: dz - REAL, DIMENSION(kts:kte+1), INTENT(in) :: zw - REAL, DIMENSION(kts:kte), INTENT(in) :: u,v,thl,qw,cldfra_bl1D,& - edmf_w1,edmf_a1 - REAL, DIMENSION(kts:kte), INTENT(out) :: tsq,qsq,cov - REAL, DIMENSION(kts:kte), INTENT(inout) :: el,qke - REAL, DIMENSION(kts:kte) :: & - &ql,pdk,pdt,pdq,pdc,dtl,dqw,dtv,& - &gm,gh,sm,sh,qkw,vt,vq - INTEGER :: k,l,lmax - REAL :: phm,vkz,elq,elv,b1l,b2l,pmz=1.,phh=1.,flt=0.,flq=0.,tmpq - REAL :: zi - REAL, DIMENSION(kts:kte) :: theta,thetav,thlsg,qwsg - REAL, DIMENSION(kts:kte) :: rstoch_col - INTEGER ::spp_pbl + integer, intent(in) :: kts,kte + integer, intent(in) :: bl_mynn_mixlength + logical, intent(in) :: INITIALIZE_QKE +! real(kind_phys), intent(in) :: ust, rmo, pmz, phh, flt, flq + real(kind_phys), intent(in) :: rmo, Psig_bl, xland + real(kind_phys), intent(in) :: dx, ust, zi + real(kind_phys), dimension(kts:kte), intent(in) :: dz + real(kind_phys), dimension(kts:kte+1), intent(in) :: zw + real(kind_phys), dimension(kts:kte), intent(in) :: u,v,thl,& + &qw,cldfra_bl1D,edmf_w1,edmf_a1 + real(kind_phys), dimension(kts:kte), intent(out) :: tsq,qsq,cov + real(kind_phys), dimension(kts:kte), intent(inout) :: el,qke + real(kind_phys), dimension(kts:kte) :: & + &ql,pdk,pdt,pdq,pdc,dtl,dqw,dtv, & + &gm,gh,sm,sh,qkw,vt,vq + integer :: k,l,lmax + real(kind_phys):: phm,vkz,elq,elv,b1l,b2l,pmz=1.,phh=1., & + &flt=0.,fltv=0.,flq=0.,tmpq + real(kind_phys), dimension(kts:kte) :: theta,thetav + real(kind_phys), dimension(kts:kte) :: rstoch_col + integer ::spp_pbl !> - At first ql, vt and vq are set to zero. DO k = kts,kte @@ -1647,7 +1558,6 @@ SUBROUTINE mym_initialize ( & CALL mym_level2 ( kts,kte, & & dz, & & u, v, thl, thetav, qw, & - & thlsg, qwsg, & & ql, vt, vq, & & dtl, dqw, dtv, gm, gh, sm, sh ) ! @@ -1689,7 +1599,7 @@ SUBROUTINE mym_initialize ( & CALL mym_length ( & & kts,kte,xland, & & dz, dx, zw, & - & rmo, flt, flq, & + & rmo, flt, fltv, flq, & & vt, vq, & & u, v, qke, & & dtv, & @@ -1807,31 +1717,31 @@ END SUBROUTINE mym_initialize SUBROUTINE mym_level2 (kts,kte, & & dz, & & u, v, thl, thetav, qw, & - & thlsg, qwsg, & & ql, vt, vq, & & dtl, dqw, dtv, gm, gh, sm, sh ) ! !------------------------------------------------------------------- - INTEGER, INTENT(IN) :: kts,kte + integer, intent(in) :: kts,kte #ifdef HARDCODE_VERTICAL # define kts 1 # define kte HARDCODE_VERTICAL #endif - REAL, DIMENSION(kts:kte), INTENT(in) :: dz - REAL, DIMENSION(kts:kte), INTENT(in) :: u,v,thl,qw,ql,vt,vq,& - thetav,thlsg,qwsg - REAL, DIMENSION(kts:kte), INTENT(out) :: & + real(kind_phys), dimension(kts:kte), intent(in) :: dz + real(kind_phys), dimension(kts:kte), intent(in) :: u,v, & + &thl,qw,ql,vt,vq,thetav + real(kind_phys), dimension(kts:kte), intent(out) :: & &dtl,dqw,dtv,gm,gh,sm,sh - INTEGER :: k + integer :: k - REAL :: rfc,f1,f2,rf1,rf2,smc,shc,& - &ri1,ri2,ri3,ri4,duz,dtz,dqz,vtt,vqq,dtq,dzk,afk,abk,ri,rf + real(kind_phys):: rfc,f1,f2,rf1,rf2,smc,shc, & + &ri1,ri2,ri3,ri4,duz,dtz,dqz,vtt,vqq,dtq,dzk, & + &afk,abk,ri,rf - REAL :: a2fac + real(kind_phys):: a2fac ! ev = 2.5e6 ! tv0 = 0.61*tref @@ -1859,11 +1769,7 @@ SUBROUTINE mym_level2 (kts,kte, & duz = ( u(k)-u(k-1) )**2 +( v(k)-v(k-1) )**2 duz = duz /dzk**2 dtz = ( thl(k)-thl(k-1) )/( dzk ) - !Alternatively, use SGS clouds for thl - !dtz = ( thlsg(k)-thlsg(k-1) )/( dzk ) dqz = ( qw(k)-qw(k-1) )/( dzk ) - !Alternatively, use SGS clouds for qw - !dqz = ( qwsg(k)-qwsg(k-1) )/( dzk ) ! vtt = 1.0 +vt(k)*abk +vt(k-1)*afk ! Beta-theta in NN09, Eq. 39 vqq = tv0 +vq(k)*abk +vq(k-1)*afk ! Beta-q @@ -1942,7 +1848,7 @@ END SUBROUTINE mym_level2 SUBROUTINE mym_length ( & & kts,kte,xland, & & dz, dx, zw, & - & rmo, flt, flq, & + & rmo, flt, fltv, flq, & & vt, vq, & & u1, v1, qke, & & dtv, & @@ -1954,58 +1860,57 @@ SUBROUTINE mym_length ( & !------------------------------------------------------------------- - INTEGER, INTENT(IN) :: kts,kte + integer, intent(in) :: kts,kte #ifdef HARDCODE_VERTICAL # define kts 1 # define kte HARDCODE_VERTICAL #endif - INTEGER, INTENT(IN) :: bl_mynn_mixlength - REAL, DIMENSION(kts:kte), INTENT(in) :: dz - REAL, DIMENSION(kts:kte+1), INTENT(in) :: zw - REAL, INTENT(in) :: rmo,flt,flq,Psig_bl,dx,xland - REAL, DIMENSION(kts:kte), INTENT(IN) :: u1,v1,qke,vt,vq,cldfra_bl1D,& - edmf_w1,edmf_a1 - REAL, DIMENSION(kts:kte), INTENT(out) :: qkw, el - REAL, DIMENSION(kts:kte), INTENT(in) :: dtv - - REAL :: elt,vsc - - REAL, DIMENSION(kts:kte), INTENT(IN) :: theta - REAL, DIMENSION(kts:kte) :: qtke,elBLmin,elBLavg,thetaw - REAL :: wt,wt2,zi,zi2,h1,h2,hs,elBLmin0,elBLavg0,cldavg + integer, intent(in) :: bl_mynn_mixlength + real(kind_phys), dimension(kts:kte), intent(in) :: dz + real(kind_phys), dimension(kts:kte+1), intent(in) :: zw + real(kind_phys), intent(in) :: rmo,flt,fltv,flq,Psig_bl,xland + real(kind_phys), intent(in) :: dx,zi + real(kind_phys), dimension(kts:kte), intent(in) :: u1,v1, & + &qke,vt,vq,cldfra_bl1D,edmf_w1,edmf_a1 + real(kind_phys), dimension(kts:kte), intent(out) :: qkw, el + real(kind_phys), dimension(kts:kte), intent(in) :: dtv + real(kind_phys):: elt,vsc + real(kind_phys), dimension(kts:kte), intent(in) :: theta + real(kind_phys), dimension(kts:kte) :: qtke,elBLmin,elBLavg,thetaw + real(kind_phys):: wt,wt2,zi2,h1,h2,hs,elBLmin0,elBLavg0,cldavg ! THE FOLLOWING CONSTANTS ARE IMPORTANT FOR REGULATING THE ! MIXING LENGTHS: - REAL :: cns, & !< for surface layer (els) in stable conditions - alp1, & !< for turbulent length scale (elt) - alp2, & !< for buoyancy length scale (elb) - alp3, & !< for buoyancy enhancement factor of elb - alp4, & !< for surface layer (els) in unstable conditions - alp5, & !< for BouLac mixing length or above PBLH - alp6 !< for mass-flux/ + real(kind_phys):: cns, & !< for surface layer (els) in stable conditions + alp1, & !< for turbulent length scale (elt) + alp2, & !< for buoyancy length scale (elb) + alp3, & !< for buoyancy enhancement factor of elb + alp4, & !< for surface layer (els) in unstable conditions + alp5, & !< for BouLac mixing length or above PBLH + alp6 !< for mass-flux/ !THE FOLLOWING LIMITS DO NOT DIRECTLY AFFECT THE ACTUAL PBLH. !THEY ONLY IMPOSE LIMITS ON THE CALCULATION OF THE MIXING LENGTH !SCALES SO THAT THE BOULAC MIXING LENGTH (IN FREE ATMOS) DOES !NOT ENCROACH UPON THE BOUNDARY LAYER MIXING LENGTH (els, elb & elt). - REAL, PARAMETER :: minzi = 300. !< min mixed-layer height - REAL, PARAMETER :: maxdz = 750. !< max (half) transition layer depth + real(kind_phys), parameter :: minzi = 300. !< min mixed-layer height + real(kind_phys), parameter :: maxdz = 750. !< max (half) transition layer depth !! =0.3*2500 m PBLH, so the transition !! layer stops growing for PBLHs > 2.5 km. - REAL, PARAMETER :: mindz = 300. !< 300 !min (half) transition layer depth + real(kind_phys), parameter :: mindz = 300. !< 300 !min (half) transition layer depth !SURFACE LAYER LENGTH SCALE MODS TO REDUCE IMPACT IN UPPER BOUNDARY LAYER - REAL, PARAMETER :: ZSLH = 100. !< Max height correlated to surface conditions (m) - REAL, PARAMETER :: CSL = 2. !< CSL = constant of proportionality to L O(1) + real(kind_phys), parameter :: ZSLH = 100. !< Max height correlated to surface conditions (m) + real(kind_phys), parameter :: CSL = 2. !< CSL = constant of proportionality to L O(1) - INTEGER :: i,j,k - REAL :: afk,abk,zwk,zwk1,dzk,qdz,vflx,bv,tau_cloud,wstar,elb,els, & - & elf,el_stab,el_mf,el_stab_mf,elb_mf, & + integer :: i,j,k + real(kind_phys):: afk,abk,zwk,zwk1,dzk,qdz,vflx,bv,tau_cloud, & + & wstar,elb,els,elf,el_stab,el_mf,el_stab_mf,elb_mf, & & PBLH_PLUS_ENT,Uonset,Ugrid,wt_u,el_les - REAL, PARAMETER :: ctau = 1000. !constant for tau_cloud + real(kind_phys), parameter :: ctau = 1000. !constant for tau_cloud ! tv0 = 0.61*tref ! gtr = 9.81/tref @@ -2095,18 +2000,18 @@ SUBROUTINE mym_length ( & ugrid = sqrt(u1(kts)**2 + v1(kts)**2) uonset= 15. wt_u = (1.0 - min(max(ugrid - uonset, 0.0)/30.0, 0.5)) - cns = 3.5 - alp1 = 0.22 !was 0.21 - alp2 = 0.25 !was 0.3 + cns = 2.7 !was 3.5 + alp1 = 0.22 + alp2 = 0.3 alp3 = 2.0 * wt_u !taper off bouyancy enhancement in shear-driven pbls alp4 = 5.0 alp5 = 0.3 alp6 = 50. ! Impose limits on the height integration for elt and the transition layer depth - zi2=MAX(zi,200.) !minzi) - h1=MAX(0.3*zi2,200.) - h1=MIN(h1,500.) ! 1/2 transition layer depth + zi2=MAX(zi,300.) !minzi) + h1=MAX(0.3*zi2,300.) + h1=MIN(h1,600.) ! 1/2 transition layer depth h2=h1/2.0 ! 1/4 transition layer depth qtke(kts)=MAX(0.5*qke(kts), 0.01) !tke at full sigma levels @@ -2139,7 +2044,7 @@ SUBROUTINE mym_length ( & elt = MIN( MAX( alp1*elt/vsc, 10.), 400.) !avoid use of buoyancy flux functions which are ill-defined at the surface !vflx = ( vt(kts)+1.0 )*flt + ( vq(kts)+tv0 )*flq - vflx = flt + vflx = fltv vsc = ( gtr*elt*MAX( vflx, 0.0 ) )**onethird ! ** Strictly, el(i,j,1) is not zero. ** @@ -2159,7 +2064,7 @@ SUBROUTINE mym_length ( & & alp6*edmf_a1(k-1)*edmf_w1(k-1)) / bv & & *( 1.0 + alp3*SQRT( vsc/(bv*elt) ) ) elb = MIN(elb, zwk) - elf = 0.65 * qkw(k)/bv + elf = 0.80 * qkw(k)/bv elBLavg(k) = MAX(elBLavg(k), alp6*edmf_a1(k-1)*edmf_w1(k-1)/bv) ELSE elb = 1.0e10 @@ -2194,20 +2099,20 @@ SUBROUTINE mym_length ( & Uonset = 3.5 + dz(kts)*0.1 Ugrid = sqrt(u1(kts)**2 + v1(kts)**2) cns = 3.5 !JOE-test * (1.0 - MIN(MAX(Ugrid - Uonset, 0.0)/10.0, 1.0)) - alp1 = 0.22 !0.21 - alp2 = 0.25 !0.30 - alp3 = 2.0 !1.5 + alp1 = 0.22 + alp2 = 0.30 + alp3 = 2.0 alp4 = 5.0 alp5 = alp2 !like alp2, but for free atmosphere alp6 = 50.0 !used for MF mixing length ! Impose limits on the height integration for elt and the transition layer depth !zi2=MAX(zi,minzi) - zi2=MAX(zi, 200.) + zi2=MAX(zi, 300.) !h1=MAX(0.3*zi2,mindz) !h1=MIN(h1,maxdz) ! 1/2 transition layer depth - h1=MAX(0.3*zi2,200.) - h1=MIN(h1,500.) + h1=MAX(0.3*zi2,300.) + h1=MIN(h1,600.) h2=h1*0.5 ! 1/4 transition layer depth qtke(kts)=MAX(0.5*qke(kts),0.01) !tke at full sigma levels @@ -2239,7 +2144,7 @@ SUBROUTINE mym_length ( & elt = MIN( MAX(alp1*elt/vsc, 10.), 400.) !avoid use of buoyancy flux functions which are ill-defined at the surface !vflx = ( vt(kts)+1.0 )*flt +( vq(kts)+tv0 )*flq - vflx = flt + vflx = fltv vsc = ( gtr*elt*MAX( vflx, 0.0 ) )**onethird ! ** Strictly, el(i,j,1) is not zero. ** @@ -2365,15 +2270,15 @@ SUBROUTINE boulac_length0(k,kts,kte,zw,dz,qtke,theta,lb1,lb2) ! lb2 = the average of the length up and length down !------------------------------------------------------------------- - INTEGER, INTENT(IN) :: k,kts,kte - REAL, DIMENSION(kts:kte), INTENT(IN) :: qtke,dz,theta - REAL, INTENT(OUT) :: lb1,lb2 - REAL, DIMENSION(kts:kte+1), INTENT(IN) :: zw + integer, intent(in) :: k,kts,kte + real(kind_phys), dimension(kts:kte), intent(in) :: qtke,dz,theta + real(kind_phys), intent(out) :: lb1,lb2 + real(kind_phys), dimension(kts:kte+1), intent(in) :: zw !LOCAL VARS - INTEGER :: izz, found - REAL :: dlu,dld - REAL :: dzt, zup, beta, zup_inf, bbb, tl, zdo, zdo_sup, zzz + integer :: izz, found + real(kind_phys):: dlu,dld + real(kind_phys):: dzt, zup, beta, zup_inf, bbb, tl, zdo, zdo_sup, zzz !---------------------------------- @@ -2515,16 +2420,16 @@ SUBROUTINE boulac_length(kts,kte,zw,dz,qtke,theta,lb1,lb2) ! lb2 = the average of the length up and length down !------------------------------------------------------------------- - INTEGER, INTENT(IN) :: kts,kte - REAL, DIMENSION(kts:kte), INTENT(IN) :: qtke,dz,theta - REAL, DIMENSION(kts:kte), INTENT(OUT) :: lb1,lb2 - REAL, DIMENSION(kts:kte+1), INTENT(IN) :: zw + integer, intent(in) :: kts,kte + real(kind_phys), dimension(kts:kte), intent(in) :: qtke,dz,theta + real(kind_phys), dimension(kts:kte), intent(out):: lb1,lb2 + real(kind_phys), dimension(kts:kte+1), intent(in) :: zw !LOCAL VARS - INTEGER :: iz, izz, found - REAL, DIMENSION(kts:kte) :: dlu,dld - REAL, PARAMETER :: Lmax=2000. !soft limit - REAL :: dzt, zup, beta, zup_inf, bbb, tl, zdo, zdo_sup, zzz + integer :: iz, izz, found + real(kind_phys), dimension(kts:kte) :: dlu,dld + real(kind_phys), parameter :: Lmax=2000. !soft limit + real(kind_phys):: dzt, zup, beta, zup_inf, bbb, tl, zdo, zdo_sup, zzz !print*,"IN MYNN-BouLac",kts, kte @@ -2712,10 +2617,9 @@ SUBROUTINE mym_turbulence ( & & xland,closure, & & dz, dx, zw, & & u, v, thl, thetav, ql, qw, & - & thlsg, qwsg, & & qke, tsq, qsq, cov, & & vt, vq, & - & rmo, flt, flq, & + & rmo, flt, fltv, flq, & & zi,theta, & & sh, sm, & & El, & @@ -2726,49 +2630,49 @@ SUBROUTINE mym_turbulence ( & & bl_mynn_mixlength, & & edmf_w1,edmf_a1, & & TKEprodTD, & - & spp_pbl,rstoch_col) + & spp_pbl,rstoch_col ) !------------------------------------------------------------------- -! - INTEGER, INTENT(IN) :: kts,kte + + integer, intent(in) :: kts,kte #ifdef HARDCODE_VERTICAL # define kts 1 # define kte HARDCODE_VERTICAL #endif - INTEGER, INTENT(IN) :: bl_mynn_mixlength,tke_budget - REAL, INTENT(IN) :: closure - REAL, DIMENSION(kts:kte), INTENT(in) :: dz - REAL, DIMENSION(kts:kte+1), INTENT(in) :: zw - REAL, INTENT(in) :: rmo,flt,flq,Psig_bl,Psig_shcu,dx,xland,zi - REAL, DIMENSION(kts:kte), INTENT(in) :: u,v,thl,thetav,qw,& - &ql,vt,vq,qke,tsq,qsq,cov,cldfra_bl1D,edmf_w1,edmf_a1,& - &TKEprodTD,thlsg,qwsg - - REAL, DIMENSION(kts:kte), INTENT(out) :: dfm,dfh,dfq,& + integer, intent(in) :: bl_mynn_mixlength,tke_budget + real(kind_phys), intent(in) :: closure + real(kind_phys), dimension(kts:kte), intent(in) :: dz + real(kind_phys), dimension(kts:kte+1), intent(in) :: zw + real(kind_phys), intent(in) :: rmo,flt,fltv,flq, & + &Psig_bl,Psig_shcu,xland,dx,zi + real(kind_phys), dimension(kts:kte), intent(in) :: u,v,thl,thetav,qw, & + &ql,vt,vq,qke,tsq,qsq,cov,cldfra_bl1D,edmf_w1,edmf_a1, & + &TKEprodTD + + real(kind_phys), dimension(kts:kte), intent(out) :: dfm,dfh,dfq, & &pdk,pdt,pdq,pdc,tcd,qcd,el - REAL, DIMENSION(kts:kte), INTENT(inout) :: & + real(kind_phys), dimension(kts:kte), intent(inout) :: & qWT1D,qSHEAR1D,qBUOY1D,qDISS1D - REAL :: q3sq_old,dlsq1,qWTP_old,qWTP_new - REAL :: dudz,dvdz,dTdz,& - upwp,vpwp,Tpwp + real(kind_phys):: q3sq_old,dlsq1,qWTP_old,qWTP_new + real(kind_phys):: dudz,dvdz,dTdz,upwp,vpwp,Tpwp - REAL, DIMENSION(kts:kte) :: qkw,dtl,dqw,dtv,gm,gh,sm,sh + real(kind_phys), dimension(kts:kte) :: qkw,dtl,dqw,dtv,gm,gh,sm,sh - INTEGER :: k -! REAL :: cc2,cc3,e1c,e2c,e3c,e4c,e5c - REAL :: e6c,dzk,afk,abk,vtt,vqq,& + integer :: k +! real(kind_phys):: cc2,cc3,e1c,e2c,e3c,e4c,e5c + real(kind_phys):: e6c,dzk,afk,abk,vtt,vqq, & &cw25,clow,cupp,gamt,gamq,smd,gamv,elq,elh - REAL :: cldavg - REAL, DIMENSION(kts:kte), INTENT(in) :: theta + real(kind_phys):: cldavg + real(kind_phys), dimension(kts:kte), intent(in) :: theta - REAL :: a2fac, duz, ri !JOE-Canuto/Kitamura mod + real(kind_phys):: a2fac, duz, ri !JOE-Canuto/Kitamura mod - REAL:: auh,aum,adh,adm,aeh,aem,Req,Rsl,Rsl2,& - gmelq,sm20,sh20,sm25max,sh25max,sm25min,sh25min,& + real:: auh,aum,adh,adm,aeh,aem,Req,Rsl,Rsl2, & + gmelq,sm20,sh20,sm25max,sh25max,sm25min,sh25min, & sm_pbl,sh_pbl,zi2,wt,slht,wtpr DOUBLE PRECISION q2sq, t2sq, r2sq, c2sq, elsq, gmel, ghel @@ -2776,11 +2680,10 @@ SUBROUTINE mym_turbulence ( & DOUBLE PRECISION e1, e2, e3, e4, enum, eden, wden ! Stochastic - INTEGER, INTENT(IN) :: spp_pbl - REAL, DIMENSION(KTS:KTE) :: rstoch_col - REAL :: Prnum, Prlim - REAL, PARAMETER :: Prlimit = 5.0 - + integer, intent(in) :: spp_pbl + real(kind_phys), dimension(kts:kte) :: rstoch_col + real(kind_phys):: Prnum, shb + real(kind_phys), parameter :: Prlimit = 5.0 ! ! tv0 = 0.61*tref @@ -2798,14 +2701,13 @@ SUBROUTINE mym_turbulence ( & CALL mym_level2 (kts,kte, & & dz, & & u, v, thl, thetav, qw, & - & thlsg, qwsg, & & ql, vt, vq, & & dtl, dqw, dtv, gm, gh, sm, sh ) ! CALL mym_length ( & & kts,kte,xland, & & dz, dx, zw, & - & rmo, flt, flq, & + & rmo, flt, fltv, flq, & & vt, vq, & & u, v, qke, & & dtv, & @@ -2985,7 +2887,8 @@ SUBROUTINE mym_turbulence ( & !Prlim = 2.0*wtpr + (1.0 - wtpr)*Prlimit !sm(k) = MIN(sm(k), Prlim*Sh(k)) !Pending more testing, keep same Pr limit in sfc layer - sm(k) = MIN(sm(k), Prlimit*Sh(k)) + shb = max(sh(k), 0.002) + sm(k) = MIN(sm(k), Prlimit*shb) ! ** Level 3 : start ** IF ( closure .GE. 3.0 ) THEN @@ -3155,7 +3058,7 @@ SUBROUTINE mym_turbulence ( & ! q-variance (pdq), and covariance (pdc) pdk(k) = elq*( sm(k)*gm(k) & & +sh(k)*gh(k)+gamv ) + & - & TKEprodTD(k) + & 0.5*TKEprodTD(k) ! xmchen pdt(k) = elh*( sh(k)*dtl(k)+gamt )*dtl(k) pdq(k) = elh*( sh(k)*dqw(k)+gamq )*dqw(k) pdc(k) = elh*( sh(k)*dtl(k)+gamt ) & @@ -3199,9 +3102,9 @@ SUBROUTINE mym_turbulence ( & !qBUOY1D(k) = elq*(sh(k)*(-dTdz*grav/thl(k)) + gamv) !! ORIGINAL CODE !! Buoyncy term takes the TKEprodTD(k) production now - qBUOY1D(k) = elq*(sh(k)*gh(k)+gamv)+TKEprodTD(k) !staggered + qBUOY1D(k) = elq*(sh(k)*gh(k)+gamv)+0.5*TKEprodTD(k) ! xmchen - !!!Dissipation Term (now it evaluated on mym_predict) + !!!Dissipation Term (now it evaluated in mym_predict) !qDISS1D(k) = (q3sq**(3./2.))/(b1*MAX(el(k),1.)) !! ORIGINAL CODE !! >> EOB @@ -3226,8 +3129,6 @@ SUBROUTINE mym_turbulence ( & qcd(k) = ( qcd(k+1)-qcd(k) )/( dzk ) END DO ! - - if (spp_pbl==1) then DO k = kts,kte dfm(k)= dfm(k) + dfm(k)* rstoch_col(k) * 1.5 * MAX(exp(-MAX(zw(k)-8000.,0.0)/2000.),0.001) @@ -3294,43 +3195,43 @@ SUBROUTINE mym_predict (kts,kte, & & delt, & & dz, & & ust, flt, flq, pmz, phh, & - & el, dfq, rho, & + & el, dfq, rho, & & pdk, pdt, pdq, pdc, & & qke, tsq, qsq, cov, & & s_aw,s_awqke,bl_mynn_edmf_tke, & & qWT1D, qDISS1D,tke_budget) !! TKE budget (Puhales, 2020) !------------------------------------------------------------------- - INTEGER, INTENT(IN) :: kts,kte + integer, intent(in) :: kts,kte #ifdef HARDCODE_VERTICAL # define kts 1 # define kte HARDCODE_VERTICAL #endif - REAL, INTENT(IN) :: closure - INTEGER, INTENT(IN) :: bl_mynn_edmf_tke, tke_budget - REAL, INTENT(IN) :: delt - REAL, DIMENSION(kts:kte), INTENT(IN) :: dz, dfq, el, rho - REAL, DIMENSION(kts:kte), INTENT(INOUT) :: pdk, pdt, pdq, pdc - REAL, INTENT(IN) :: flt, flq, ust, pmz, phh - REAL, DIMENSION(kts:kte), INTENT(INOUT) :: qke,tsq, qsq, cov + real(kind_phys), intent(in) :: closure + integer, intent(in) :: bl_mynn_edmf_tke,tke_budget + real(kind_phys), dimension(kts:kte), intent(in) :: dz, dfq, el, rho + real(kind_phys), dimension(kts:kte), intent(inout) :: pdk, pdt, pdq, pdc + real(kind_phys), intent(in) :: flt, flq, pmz, phh + real(kind_phys), intent(in) :: ust, delt + real(kind_phys), dimension(kts:kte), intent(inout) :: qke,tsq, qsq, cov ! WA 8/3/15 - REAL, DIMENSION(kts:kte+1), INTENT(INOUT) :: s_awqke,s_aw + real(kind_phys), dimension(kts:kte+1), intent(inout) :: s_awqke,s_aw !! TKE budget (Puhales, 2020, WRF 4.2.1) << EOB - REAL, DIMENSION(kts:kte), INTENT(OUT) :: qWT1D, qDISS1D - REAL, DIMENSION(kts:kte) :: tke_up,dzinv + real(kind_phys), dimension(kts:kte), intent(out) :: qWT1D, qDISS1D + real(kind_phys), dimension(kts:kte) :: tke_up,dzinv !! >> EOB - INTEGER :: k - REAL, DIMENSION(kts:kte) :: qkw, bp, rp, df3q - REAL :: vkz,pdk1,phm,pdt1,pdq1,pdc1,b1l,b2l,onoff - REAL, DIMENSION(kts:kte) :: dtz - REAL, DIMENSION(kts:kte) :: a,b,c,d,x + integer :: k + real(kind_phys), dimension(kts:kte) :: qkw, bp, rp, df3q + real(kind_phys):: vkz,pdk1,phm,pdt1,pdq1,pdc1,b1l,b2l,onoff + real(kind_phys), dimension(kts:kte) :: dtz + real(kind_phys), dimension(kts:kte) :: a,b,c,d,x - REAL, DIMENSION(kts:kte) :: rhoinv - REAL, DIMENSION(kts:kte+1) :: rhoz,kqdz,kmdz + real(kind_phys), dimension(kts:kte) :: rhoinv + real(kind_phys), dimension(kts:kte+1) :: rhoz,kqdz,kmdz ! REGULATE THE MOMENTUM MIXING FROM THE MASS-FLUX SCHEME (on or off) IF (bl_mynn_edmf_tke == 0) THEN @@ -3376,7 +3277,7 @@ SUBROUTINE mym_predict (kts,kte, & kmdz(k) = MAX(kmdz(k), 0.5* s_aw(k)) kmdz(k) = MAX(kmdz(k), -0.5*(s_aw(k)-s_aw(k+1))) ENDDO -!JOE-end conservation mods + !end conservation mods pdk1 = 2.0*ust**3*pmz/( vkz ) phm = 2.0/ust *phh/( vkz ) @@ -3384,8 +3285,8 @@ SUBROUTINE mym_predict (kts,kte, & pdq1 = phm*flq**2 pdc1 = phm*flt*flq ! -! ** pdk(i,j,1)+pdk(i,j,2) corresponds to pdk1. ** - pdk(kts) = pdk1 -pdk(kts+1) +! ** pdk(1)+pdk(2) corresponds to pdk1. ** + pdk(kts) = pdk1 - pdk(kts+1) !! pdt(kts) = pdt1 -pdt(kts+1) !! pdq(kts) = pdq1 -pdq(kts+1) @@ -3480,7 +3381,7 @@ SUBROUTINE mym_predict (kts,kte, & ENDDO k=kte qWT1D(k)=dzinv(k)*(-kqdz(k)*(tke_up(k)-tke_up(k-1)) & - & + 0.5*rhoinv(k)*(-s_aw(k)*tke_up(k)-s_aw(k)*tke_up(k-1)+s_awqke(k))*onoff) !unstaggared + & + 0.5*rhoinv(k)*(-s_aw(k)*tke_up(k)-s_aw(k)*tke_up(k-1)+s_awqke(k))*onoff) !unstaggered !! >> EOBvt qDISS1D=bp*tke_up !! TKE dissipation rate !unstaggered END IF @@ -3697,7 +3598,7 @@ END SUBROUTINE mym_predict !! use of the namelist parameter \p bl_mynn_cloudpdf . SUBROUTINE mym_condensation (kts,kte, & & dx, dz, zw, xland, & - & thl, qw, qv, qc, qi, & + & thl, qw, qv, qc, qi, qs, & & p,exner, & & tsq, qsq, cov, & & Sh, el, bl_mynn_cloudpdf, & @@ -3709,50 +3610,56 @@ SUBROUTINE mym_condensation (kts,kte, & !------------------------------------------------------------------- - INTEGER, INTENT(IN) :: kts,kte, bl_mynn_cloudpdf + integer, intent(in) :: kts,kte, bl_mynn_cloudpdf #ifdef HARDCODE_VERTICAL # define kts 1 # define kte HARDCODE_VERTICAL #endif - REAL, INTENT(IN) :: dx,PBLH1,HFX1,rmo,xland - REAL, DIMENSION(kts:kte), INTENT(IN) :: dz - REAL, DIMENSION(kts:kte+1), INTENT(IN) :: zw - REAL, DIMENSION(kts:kte), INTENT(IN) :: p,exner,thl,qw,qv,qc,qi, & - &tsq, qsq, cov, th + real(kind_phys), intent(in) :: HFX1,rmo,xland + real(kind_phys), intent(in) :: dx,pblh1 + real(kind_phys), dimension(kts:kte), intent(in) :: dz + real(kind_phys), dimension(kts:kte+1), intent(in) :: zw + real(kind_phys), dimension(kts:kte), intent(in) :: p,exner,thl,qw, & + &qv,qc,qi,qs,tsq,qsq,cov,th - REAL, DIMENSION(kts:kte), INTENT(INOUT) :: vt,vq,sgm + real(kind_phys), dimension(kts:kte), intent(inout) :: vt,vq,sgm - REAL, DIMENSION(kts:kte) :: alp,a,bet,b,ql,q1,RH - REAL, DIMENSION(kts:kte), INTENT(OUT) :: qc_bl1D,qi_bl1D, & - cldfra_bl1D + real(kind_phys), dimension(kts:kte) :: alp,a,bet,b,ql,q1,RH + real(kind_phys), dimension(kts:kte), intent(out) :: qc_bl1D,qi_bl1D, & + &cldfra_bl1D DOUBLE PRECISION :: t3sq, r3sq, c3sq - REAL :: qsl,esat,qsat,dqsl,cld0,q1k,qlk,eq1,qll,& - &q2p,pt,rac,qt,t,xl,rsl,cpm,Fng,qww,alpha,beta,bb,& - &ls,wt,cld_factor,fac_damp,liq_frac,ql_ice,ql_water,& - &qmq,qsat_tk - INTEGER :: i,j,k + real(kind_phys):: qsl,esat,qsat,dqsl,cld0,q1k,qlk,eq1,qll, & + &q2p,pt,rac,qt,t,xl,rsl,cpm,Fng,qww,alpha,beta,bb, & + &ls,wt,qpct,cld_factor,fac_damp,liq_frac,ql_ice,ql_water, & + &qmq,qsat_tk,q1_rh,rh_hack,dzm1,zsl,maxqc + real(kind_phys), parameter :: qpct_sfc=0.025 + real(kind_phys), parameter :: qpct_pbl=0.030 + real(kind_phys), parameter :: qpct_trp=0.040 + real(kind_phys), parameter :: rhcrit =0.83 !for cloudpdf = 2 + real(kind_phys), parameter :: rhmax =1.01 !for cloudpdf = 2 + integer :: i,j,k - REAL :: erf + real(kind_phys):: erf !VARIABLES FOR ALTERNATIVE SIGMA - REAL::dth,dtl,dqw,dzk,els - REAL, DIMENSION(kts:kte), INTENT(IN) :: Sh,el + real:: dth,dtl,dqw,dzk,els + real(kind_phys), dimension(kts:kte), intent(in) :: Sh,el !variables for SGS BL clouds - REAL :: zagl,damp,PBLH2 - REAL :: cfmax + real(kind_phys) :: zagl,damp,PBLH2 + real(kind_phys) :: cfmax !JAYMES: variables for tropopause-height estimation - REAL :: theta1, theta2, ht1, ht2 - INTEGER :: k_tropo + real(kind_phys) :: theta1, theta2, ht1, ht2 + integer :: k_tropo ! Stochastic - INTEGER, INTENT(IN) :: spp_pbl - REAL, DIMENSION(KTS:KTE) :: rstoch_col - REAL :: qw_pert + integer, intent(in) :: spp_pbl + real(kind_phys), dimension(kts:kte) :: rstoch_col + real(kind_phys) :: qw_pert ! First, obtain an estimate for the tropopause height (k), using the method employed in the ! Thompson subgrid-cloud scheme. This height will be a consideration later when determining @@ -3828,9 +3735,6 @@ SUBROUTINE mym_condensation (kts,kte, & qc_bl1D(k) = liq_frac*ql(k) qi_bl1D(k) = (1.0 - liq_frac)*ql(k) - if(cldfra_bl1D(k)>0.01 .and. qc_bl1D(k)<1.E-6)qc_bl1D(k)=1.E-6 - if(cldfra_bl1D(k)>0.01 .and. qi_bl1D(k)<1.E-8)qi_bl1D(k)=1.E-8 - !Now estimate the buoyancy flux functions q2p = xlvcp/exner(k) pt = thl(k) +q2p*ql(k) ! potential temp @@ -3888,9 +3792,6 @@ SUBROUTINE mym_condensation (kts,kte, & qc_bl1D(k) = liq_frac*ql(k) qi_bl1D(k) = (1.0 - liq_frac)*ql(k) - if(cldfra_bl1D(k)>0.01 .and. qc_bl1D(k)<1.E-6)qc_bl1D(k)=1.E-6 - if(cldfra_bl1D(k)>0.01 .and. qi_bl1D(k)<1.E-8)qi_bl1D(k)=1.E-8 - !Now estimate the buoyancy flux functions q2p = xlvcp/exner(k) pt = thl(k) +q2p*ql(k) ! potential temp @@ -3911,43 +3812,83 @@ SUBROUTINE mym_condensation (kts,kte, & !Diagnostic statistical scheme of Chaboureau and Bechtold (2002), JAS !but with use of higher-order moments to estimate sigma - PBLH2=MAX(10.,PBLH1) + pblh2=MAX(10._kind_phys,pblh1) zagl = 0. + dzm1 = 0. DO k = kts,kte-1 - zagl = zagl + dz(k) - t = th(k)*exner(k) + zagl = zagl + 0.5*(dz(k) + dzm1) + dzm1 = dz(k) - xl = xl_blend(t) ! obtain latent heat - qsat_tk = qsat_blend(t, p(k)) ! saturation water vapor mixing ratio at tk and p - rh(k)=MAX(MIN(1.0,qw(k)/MAX(1.E-8,qsat_tk)),0.001) + t = th(k)*exner(k) + xl = xl_blend(t) ! obtain latent heat + qsat_tk= qsat_blend(t, p(k)) ! saturation water vapor mixing ratio at tk and p + rh(k) = MAX(MIN(rhmax, qw(k)/MAX(1.E-10,qsat_tk)),0.001_kind_phys) !dqw/dT: Clausius-Clapeyron - dqsl = qsat_tk*ep_2*xlv/( r_d*t**2 ) + dqsl = qsat_tk*ep_2*xlv/( r_d*t**2 ) alp(k) = 1.0/( 1.0+dqsl*xlvcp ) bet(k) = dqsl*exner(k) - rsl = xl*qsat_tk / (r_v*t**2) ! slope of C-C curve at t (=abs temperature) + rsl = xl*qsat_tk / (r_v*t**2) ! slope of C-C curve at t (=abs temperature) ! CB02, Eqn. 4 - cpm = cp + qw(k)*cpv ! CB02, sec. 2, para. 1 - a(k) = 1./(1. + xl*rsl/cpm) ! CB02 variable "a" - b(k) = a(k)*rsl ! CB02 variable "b" + cpm = cp + qw(k)*cpv ! CB02, sec. 2, para. 1 + a(k) = 1./(1. + xl*rsl/cpm) ! CB02 variable "a" + b(k) = a(k)*rsl ! CB02 variable "b" !SPP - qw_pert = qw(k) + qw(k)*0.5*rstoch_col(k)*real(spp_pbl) + qw_pert= qw(k) + qw(k)*0.5*rstoch_col(k)*real(spp_pbl) !This form of qmq (the numerator of Q1) no longer uses the a(k) factor qmq = qw_pert - qsat_tk ! saturation deficit/excess; !Use the form of Eq. (6) in Chaboureau and Bechtold (2002) !except neglect all but the first term for sig_r - r3sq = MAX( qsq(k), 0.0 ) + r3sq = max( qsq(k), 0.0 ) !Calculate sigma using higher-order moments: sgm(k) = SQRT( r3sq ) - !Set limits on sigma relative to saturation water vapor - sgm(k) = MIN( sgm(k), qsat_tk*0.666 ) !500 ) - sgm(k) = MAX( sgm(k), qsat_tk*0.035 ) !Note: 0.02 results in SWDOWN similar - !to the first-order version of sigma - q1(k) = qmq / sgm(k) ! Q1, the normalized saturation + !Set constraints on sigma relative to saturation water vapor + sgm(k) = min( sgm(k), qsat_tk*0.666 ) + !sgm(k) = max( sgm(k), qsat_tk*0.035 ) + + !introduce vertical grid spacing dependence on min sgm + wt = max(500. - max(dz(k)-100.,0.0), 0.0_kind_phys)/500. !=1 for dz < 100 m, =0 for dz > 600 m + sgm(k) = sgm(k) + sgm(k)*0.2*(1.0-wt) !inflate sgm for coarse dz + + !allow min sgm to vary with dz and z. + qpct = qpct_pbl*wt + qpct_trp*(1.0-wt) + qpct = min(qpct, max(qpct_sfc, qpct_pbl*zagl/500.) ) + sgm(k) = max( sgm(k), qsat_tk*qpct ) + + q1(k) = qmq / sgm(k) ! Q1, the normalized saturation + + !Add condition for falling/settling into low-RH layers, so at least + !some cloud fraction is applied for all qc, qs, and qi. + rh_hack= rh(k) + !ensure adequate RH & q1 when qi is at least 1e-9 (above the PBLH) + if (qi(k)>1.e-9 .and. zagl .gt. pblh2) then + rh_hack =min(rhmax, rhcrit + 0.07*(9.0 + log10(qi(k)))) + rh(k) =max(rh(k), rh_hack) + !add rh-based q1 + q1_rh =-3. + 3.*(rh(k)-rhcrit)/(1.-rhcrit) + q1(k) =max(q1_rh, q1(k) ) + endif + !ensure adequate RH & q1 when qc is at least 1e-6 + if (qc(k)>1.e-6) then + rh_hack =min(rhmax, rhcrit + 0.09*(6.0 + log10(qc(k)))) + rh(k) =max(rh(k), rh_hack) + !add rh-based q1 + q1_rh =-3. + 3.*(rh(k)-rhcrit)/(1.-rhcrit) + q1(k) =max(q1_rh, q1(k) ) + endif + !ensure adequate RH & q1 when qs is at least 1e-8 (above the PBLH) + if (qs(k)>1.e-8 .and. zagl .gt. pblh2) then + rh_hack =min(rhmax, rhcrit + 0.07*(8.0 + log10(qs(k)))) + rh(k) =max(rh(k), rh_hack) + !add rh-based q1 + q1_rh =-3. + 3.*(rh(k)-rhcrit)/(1.-rhcrit) + q1(k) =max(q1_rh, q1(k) ) + endif + q1k = q1(k) ! backup Q1 for later modification ! Specify cloud fraction @@ -3956,61 +3897,41 @@ SUBROUTINE mym_condensation (kts,kte, & !Waynes LES fit - over-diffuse, when limits removed from vt & vq & fng !cldfra_bl1D(K) = max(0., min(1., 0.5+0.36*atan(1.2*(q1(k)+0.4)))) !Best compromise: Improves marine stratus without adding much cold bias. - cldfra_bl1D(K) = max(0., min(1., 0.5+0.36*atan(1.8*(q1(k)+0.2)))) + cldfra_bl1D(k) = max(0., min(1., 0.5+0.36*atan(1.8*(q1(k)+0.2)))) ! Specify hydrometeors ! JAYMES- this option added 8 May 2015 ! The cloud water formulations are taken from CB02, Eq. 8. - IF (q1k < 0.) THEN !unsaturated - ql_water = sgm(k)*EXP(1.2*q1k-1) - ql_ice = sgm(k)*EXP(1.2*q1k-1.) - ELSE IF (q1k > 2.) THEN !supersaturated - ql_water = sgm(k)*q1k - ql_ice = sgm(k)*q1k - ELSE !slightly saturated (0 > q1 < 2) - ql_water = sgm(k)*(EXP(-1.) + 0.66*q1k + 0.086*q1k**2) - ql_ice = sgm(k)*(EXP(-1.) + 0.66*q1k + 0.086*q1k**2) - ENDIF + maxqc = max(qw(k) - qsat_tk, 0.0) + if (q1k < 0.) then !unsaturated + ql_water = sgm(k)*exp(1.2*q1k-1.) + ql_ice = sgm(k)*exp(1.2*q1k-1.) + elseif (q1k > 2.) then !supersaturated + ql_water = min(sgm(k)*q1k, maxqc) + ql_ice = sgm(k)*q1k + else !slightly saturated (0 > q1 < 2) + ql_water = min(sgm(k)*(exp(-1.) + 0.66*q1k + 0.086*q1k**2), maxqc) + ql_ice = sgm(k)*(exp(-1.) + 0.66*q1k + 0.086*q1k**2) + endif !In saturated grid cells, use average of SGS and resolved values - if ( qc(k) > 1.e-6 ) ql_water = 0.5 * ( ql_water + qc(k) ) - !since ql_ice is actually the total frozen condensate (snow+ice), - !do not average with grid-scale ice alone - !if ( qi(k) > 1.e-9 ) ql_ice = 0.5 * ( ql_ice + qi(k) ) + !if ( qc(k) > 1.e-6 ) ql_water = 0.5 * ( ql_water + qc(k) ) + !ql_ice is actually the total frozen condensate (snow+ice), + !if ( (qi(k)+qs(k)) > 1.e-9 ) ql_ice = 0.5 * ( ql_ice + (qi(k)+qs(k)) ) - if (cldfra_bl1D(k) < 0.01) then + if (cldfra_bl1D(k) < 0.001) then ql_ice = 0.0 ql_water = 0.0 cldfra_bl1D(k) = 0.0 endif - !PHASE PARTITIONING: currently commented out since we are moving towards prognostic sgs clouds - !Make some inferences about the relative amounts of - !subgrid cloud water vs. ice based on collocated explicit clouds. Otherise, - !use a simple temperature-dependent partitioning. - ! IF ( qc(k) + qi(k) > 0.0 ) THEN ! explicit condensate exists, retain its phase partitioning - ! IF ( qi(k) == 0.0 ) THEN ! explicit contains no ice; assume subgrid liquid - ! liq_frac = 1.0 - ! ELSE IF ( qc(k) == 0.0 ) THEN ! explicit contains no liquid; assume subgrid ice - ! liq_frac = 0.0 - ! ELSE IF ( (qc(k) >= 1.E-10) .AND. (qi(k) >= 1.E-10) ) THEN ! explicit contains mixed phase of workably - ! ! large amounts; assume subgrid follows - ! ! same partioning - ! liq_frac = qc(k) / ( qc(k) + qi(k) ) - ! ELSE - ! liq_frac = MIN(1.0, MAX(0.0, (t-tice)/(t0c-tice))) ! explicit contains mixed phase, but at least one - ! ! species is very small, so make a temperature- - ! ! depedent guess - ! ENDIF - ! ELSE ! no explicit condensate, so make a temperature-dependent guess - liq_frac = MIN(1.0, MAX(0.0, (t-tice)/(tliq-tice))) - ! ENDIF - + liq_frac = MIN(1.0, MAX(0.0, (t-tice)/(tliq-tice))) qc_bl1D(k) = liq_frac*ql_water ! apply liq_frac to ql_water and ql_ice qi_bl1D(k) = (1.0-liq_frac)*ql_ice - !Above tropopause: eliminate subgrid clouds from CB scheme - if (k .ge. k_tropo-1) then + !Above tropopause: eliminate subgrid clouds from CB scheme. Note that this was + !"k_tropo - 1" as of 20 Feb 2023. Changed to allow more high-level clouds. + if (k .ge. k_tropo) then cldfra_bl1D(K) = 0. qc_bl1D(k) = 0. qi_bl1D(k) = 0. @@ -4018,8 +3939,12 @@ SUBROUTINE mym_condensation (kts,kte, & !Buoyancy-flux-related calculations follow... !limiting Q1 to avoid too much diffusion in cloud layers - q1k=max(Q1(k),-2.0) - + !q1k=max(Q1(k),-2.0) + if ((xland-1.5).GE.0) then ! water + q1k=max(Q1(k),-2.5) + else ! land + q1k=max(Q1(k),-2.0) + endif ! "Fng" represents the non-Gaussian transport factor ! (non-dimensional) from Bechtold et al. 1995 ! (hereafter BCMT95), section 3(c). Their suggested @@ -4032,23 +3957,28 @@ SUBROUTINE mym_condensation (kts,kte, & ! Fng = 1.-1.5*q1k !ENDIF ! Use the form of "Fng" from Bechtold and Siebesma (1998, JAS) - IF (q1k .GE. 1.0) THEN + if (q1k .ge. 1.0) then Fng = 1.0 - ELSEIF (q1k .GE. -1.7 .AND. q1k .LT. 1.0) THEN - Fng = EXP(-0.4*(q1k-1.0)) - ELSEIF (q1k .GE. -2.5 .AND. q1k .LT. -1.7) THEN - Fng = 3.0 + EXP(-3.8*(q1k+1.7)) - ELSE - Fng = MIN(23.9 + EXP(-1.6*(q1k+2.5)), 60.) - ENDIF + elseif (q1k .ge. -1.7 .and. q1k .lt. 1.0) then + Fng = exp(-0.4*(q1k-1.0)) + elseif (q1k .ge. -2.5 .and. q1k .lt. -1.7) then + Fng = 3.0 + exp(-3.8*(q1k+1.7)) + else + Fng = min(23.9 + exp(-1.6*(q1k+2.5)), 60._kind_phys) + endif - cfmax= min(cldfra_bl1D(k), 0.5) - bb = b(k)*t/th(k) ! bb is "b" in BCMT95. Their "b" differs from - ! "b" in CB02 (i.e., b(k) above) by a factor + cfmax = min(cldfra_bl1D(k), 0.6_kind_phys) + !Further limit the cf going into vt & vq near the surface + zsl = min(max(25., 0.1*pblh2), 100.) + wt = min(zagl/zsl, 1.0) !=0 at z=0 m, =1 above ekman layer + cfmax = cfmax*wt + + bb = b(k)*t/th(k) ! bb is "b" in BCMT95. Their "b" differs from + ! "b" in CB02 (i.e., b(k) above) by a factor ! of T/theta. Strictly, b(k) above is formulated in ! terms of sat. mixing ratio, but bb in BCMT95 is ! cast in terms of sat. specific humidity. The - ! conversion is neglected here. + ! conversion is neglected here. qww = 1.+0.61*qw(k) alpha = 0.61*th(k) beta = (th(k)/t)*(xl/cp) - 1.61*th(k) @@ -4064,8 +3994,8 @@ SUBROUTINE mym_condensation (kts,kte, & fac_damp = min(zagl * 0.0025, 1.0) !cld_factor = 1.0 + fac_damp*MAX(0.0, ( RH(k) - 0.75 ) / 0.26 )**1.9 !HRRRv4 !cld_factor = 1.0 + fac_damp*min((max(0.0, ( RH(k) - 0.92 )) / 0.25 )**2, 0.3) - cld_factor = 1.0 + fac_damp*min((max(0.0, ( RH(k) - 0.92 )) / 0.145)**2, 0.4) - cldfra_bl1D(K) = MIN( 1., cld_factor*cldfra_bl1D(K) ) + cld_factor = 1.0 + fac_damp*min((max(0.0, ( RH(k) - 0.92 )) / 0.145)**2, 0.35) + cldfra_bl1D(K) = min( 1., cld_factor*cldfra_bl1D(K) ) enddo END SELECT !end cloudPDF option @@ -4098,52 +4028,54 @@ END SUBROUTINE mym_condensation !>\ingroup gsd_mynn_edmf !! This subroutine solves for tendencies of U, V, \f$\theta\f$, qv, !! qc, and qi - SUBROUTINE mynn_tendencies(kts,kte,i, & - &delt,dz,rho, & - &u,v,th,tk,qv,qc,qi,qnc,qni, & - &psfc,p,exner, & - &thl,sqv,sqc,sqi,sqw, & - &qnwfa,qnifa,qnbca,ozone, & - &ust,flt,flq,flqv,flqc,wspd, & - &uoce,voce, & - &tsq,qsq,cov, & - &tcd,qcd, & - &dfm,dfh,dfq, & - &Du,Dv,Dth,Dqv,Dqc,Dqi,Dqnc,Dqni, & - &Dqnwfa,Dqnifa,Dqnbca,Dozone, & - &diss_heat, & - &s_aw,s_awthl,s_awqt,s_awqv,s_awqc, & - &s_awu,s_awv, & - &s_awqnc,s_awqni, & - &s_awqnwfa,s_awqnifa,s_awqnbca, & - &sd_aw,sd_awthl,sd_awqt,sd_awqv, & - &sd_awqc,sd_awu,sd_awv, & - &sub_thl,sub_sqv, & - &sub_u,sub_v, & - &det_thl,det_sqv,det_sqc, & - &det_u,det_v, & - &FLAG_QC,FLAG_QI,FLAG_QNC,FLAG_QNI, & - &FLAG_QNWFA,FLAG_QNIFA,FLAG_QNBCA, & - &cldfra_bl1d, & - &bl_mynn_cloudmix, & - &bl_mynn_mixqt, & - &bl_mynn_edmf, & - &bl_mynn_edmf_mom, & - &bl_mynn_mixscalars ) + SUBROUTINE mynn_tendencies(kts,kte,i, & + &delt,dz,rho, & + &u,v,th,tk,qv,qc,qi,qs,qnc,qni, & + &psfc,p,exner, & + &thl,sqv,sqc,sqi,sqs,sqw, & + &qnwfa,qnifa,qnbca,ozone, & + &ust,flt,flq,flqv,flqc,wspd, & + &uoce,voce, & + &tsq,qsq,cov, & + &tcd,qcd, & + &dfm,dfh,dfq, & + &Du,Dv,Dth,Dqv,Dqc,Dqi,Dqs,Dqnc,Dqni, & + &Dqnwfa,Dqnifa,Dqnbca,Dozone, & + &diss_heat, & + &s_aw,s_awthl,s_awqt,s_awqv,s_awqc, & + &s_awu,s_awv, & + &s_awqnc,s_awqni, & + &s_awqnwfa,s_awqnifa,s_awqnbca, & + &sd_aw,sd_awthl,sd_awqt,sd_awqv, & + &sd_awqc,sd_awu,sd_awv, & + &sub_thl,sub_sqv, & + &sub_u,sub_v, & + &det_thl,det_sqv,det_sqc, & + &det_u,det_v, & + &FLAG_QC,FLAG_QI,FLAG_QNC,FLAG_QNI, & + &FLAG_QS, & + &FLAG_QNWFA,FLAG_QNIFA,FLAG_QNBCA, & + &FLAG_OZONE, & + &cldfra_bl1d, & + &bl_mynn_cloudmix, & + &bl_mynn_mixqt, & + &bl_mynn_edmf, & + &bl_mynn_edmf_mom, & + &bl_mynn_mixscalars ) !------------------------------------------------------------------- - INTEGER, INTENT(in) :: kts,kte,i + integer, intent(in) :: kts,kte,i #ifdef HARDCODE_VERTICAL # define kts 1 # define kte HARDCODE_VERTICAL #endif - INTEGER, INTENT(in) :: bl_mynn_cloudmix,bl_mynn_mixqt,& - bl_mynn_edmf,bl_mynn_edmf_mom, & + integer, intent(in) :: bl_mynn_cloudmix,bl_mynn_mixqt, & + bl_mynn_edmf,bl_mynn_edmf_mom, & bl_mynn_mixscalars - LOGICAL, INTENT(IN) :: FLAG_QI,FLAG_QNI,FLAG_QC,FLAG_QNC,& - FLAG_QNWFA,FLAG_QNIFA,FLAG_QNBCA + logical, intent(in) :: FLAG_QI,FLAG_QNI,FLAG_QC,FLAG_QS, & + &FLAG_QNC,FLAG_QNWFA,FLAG_QNIFA,FLAG_QNBCA,FLAG_OZONE ! thl - liquid water potential temperature ! qw - total water @@ -4152,46 +4084,47 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & ! flq - surface flux of qw ! mass-flux plumes - REAL, DIMENSION(kts:kte+1), INTENT(in) :: s_aw,s_awthl,s_awqt,& - &s_awqnc,s_awqni,s_awqv,s_awqc,s_awu,s_awv, & - &s_awqnwfa,s_awqnifa,s_awqnbca, & + real(kind_phys), dimension(kts:kte+1), intent(in) :: s_aw, & + &s_awthl,s_awqt,s_awqnc,s_awqni,s_awqv,s_awqc,s_awu,s_awv, & + &s_awqnwfa,s_awqnifa,s_awqnbca, & &sd_aw,sd_awthl,sd_awqt,sd_awqv,sd_awqc,sd_awu,sd_awv ! tendencies from mass-flux environmental subsidence and detrainment - REAL, DIMENSION(kts:kte), INTENT(in) :: sub_thl,sub_sqv, & + real(kind_phys), dimension(kts:kte), intent(in) :: sub_thl,sub_sqv, & &sub_u,sub_v,det_thl,det_sqv,det_sqc,det_u,det_v - REAL, DIMENSION(kts:kte), INTENT(in) :: u,v,th,tk,qv,qc,qi,qni,qnc,& - &rho,p,exner,dfq,dz,tsq,qsq,cov,tcd,qcd,cldfra_bl1d,diss_heat - REAL, DIMENSION(kts:kte), INTENT(inout) :: thl,sqw,sqv,sqc,sqi,& - &qnwfa,qnifa,qnbca,ozone,dfm,dfh - REAL, DIMENSION(kts:kte), INTENT(inout) :: du,dv,dth,dqv,dqc,dqi,& - &dqni,dqnc,dqnwfa,dqnifa,dqnbca,dozone - REAL, INTENT(IN) :: delt,ust,flt,flq,flqv,flqc,wspd,uoce,voce,& - &psfc + real(kind_phys), dimension(kts:kte), intent(in) :: u,v,th,tk,qv,qc,qi,& + &qs,qni,qnc,rho,p,exner,dfq,dz,tsq,qsq,cov,tcd,qcd, & + &cldfra_bl1d,diss_heat + real(kind_phys), dimension(kts:kte), intent(inout) :: thl,sqw,sqv,sqc,& + &sqi,sqs,qnwfa,qnifa,qnbca,ozone,dfm,dfh + real(kind_phys), dimension(kts:kte), intent(inout) :: du,dv,dth,dqv, & + &dqc,dqi,dqs,dqni,dqnc,dqnwfa,dqnifa,dqnbca,dozone + real(kind_phys), intent(in) :: flt,flq,flqv,flqc,uoce,voce + real(kind_phys), intent(in) :: ust,delt,psfc,wspd !debugging - REAL ::wsp,wsp2,tk2,th2 - LOGICAL :: problem + real(kind_phys):: wsp,wsp2,tk2,th2 + logical :: problem integer :: kproblem -! REAL, INTENT(IN) :: gradu_top,gradv_top,gradth_top,gradqv_top +! real(kind_phys), intent(in) :: gradu_top,gradv_top,gradth_top,gradqv_top !local vars - REAL, DIMENSION(kts:kte) :: dtz,dfhc,dfmc,delp - REAL, DIMENSION(kts:kte) :: sqv2,sqc2,sqi2,sqw2,qni2,qnc2, & !AFTER MIXING - qnwfa2,qnifa2,qnbca2,ozone2 - REAL, DIMENSION(kts:kte) :: zfac,plumeKh,rhoinv - REAL, DIMENSION(kts:kte) :: a,b,c,d,x - REAL, DIMENSION(kts:kte+1) :: rhoz, & !rho on model interface - & khdz, kmdz - REAL :: rhs,gfluxm,gfluxp,dztop,maxdfh,mindfh,maxcf,maxKh,zw - REAL :: t,esat,qsl,onoff,kh,km,dzk,rhosfc - REAL :: ustdrag,ustdiff,qvflux - REAL :: th_new,portion_qc,portion_qi,condensate,qsat - INTEGER :: k,kk + real(kind_phys), dimension(kts:kte) :: dtz,dfhc,dfmc,delp + real(kind_phys), dimension(kts:kte) :: sqv2,sqc2,sqi2,sqs2,sqw2, & + &qni2,qnc2,qnwfa2,qnifa2,qnbca2,ozone2 + real(kind_phys), dimension(kts:kte) :: zfac,plumeKh,rhoinv + real(kind_phys), dimension(kts:kte) :: a,b,c,d,x + real(kind_phys), dimension(kts:kte+1) :: rhoz, & !rho on model interface + &khdz,kmdz + real(kind_phys):: rhs,gfluxm,gfluxp,dztop,maxdfh,mindfh,maxcf,maxKh,zw + real(kind_phys):: t,esat,qsl,onoff,kh,km,dzk,rhosfc + real(kind_phys):: ustdrag,ustdiff,qvflux + real(kind_phys):: th_new,portion_qc,portion_qi,condensate,qsat + integer :: k,kk !Activate nonlocal mixing from the mass-flux scheme for !number concentrations and aerosols (0.0 = no; 1.0 = yes) - REAL, PARAMETER :: nonloc = 1.0 + real(kind_phys), parameter :: nonloc = 1.0 dztop=.5*(dz(kte)+dz(kte-1)) @@ -4648,19 +4581,6 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & IF (bl_mynn_cloudmix > 0 .AND. FLAG_QI) THEN k=kts - -! a(k)=0. -! b(k)=1.+dtz(k)*dfh(k+1) -! c(k)= -dtz(k)*dfh(k+1) -! d(k)=sqi(k) !+ qcd(k)*delt !should we have qcd for ice? -! -! DO k=kts+1,kte-1 -! a(k)= -dtz(k)*dfh(k) -! b(k)=1.+dtz(k)*(dfh(k)+dfh(k+1)) -! c(k)= -dtz(k)*dfh(k+1) -! d(k)=sqi(k) !+ qcd(k)*delt -! ENDDO - !rho-weighted: a(k)= -dtz(k)*khdz(k)*rhoinv(k) b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))*rhoinv(k) @@ -4704,6 +4624,43 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & sqi2=sqi ENDIF +!============================================ +! MIX SNOW ( sqs ) +!============================================ +!hard-code to not mix snow +IF (bl_mynn_cloudmix > 0 .AND. .false.) THEN + + k=kts +!rho-weighted: + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))*rhoinv(k) + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) + d(k)=sqs(k) + + DO k=kts+1,kte-1 + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))*rhoinv(k) + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) + d(k)=sqs(k) + ENDDO + +!! prescribed value + a(kte)=0. + b(kte)=1. + c(kte)=0. + d(kte)=sqs(kte) + +! CALL tridiag(kte,a,b,c,d) + CALL tridiag2(kte,a,b,c,d,sqs2) +! CALL tridiag3(kte,a,b,c,d,sqs2) + +! DO k=kts,kte +! sqs2(k)=d(k-kts+1) +! ENDDO +ELSE + sqs2=sqs +ENDIF + !!============================================ !! cloud ice number concentration (qni) !!============================================ @@ -4898,8 +4855,8 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & d(kte)=qnbca(kte) ! CALL tridiag(kte,a,b,c,d) -! CALL tridiag2(kte,a,b,c,d,x) - CALL tridiag3(kte,a,b,c,d,x) + CALL tridiag2(kte,a,b,c,d,x) +! CALL tridiag3(kte,a,b,c,d,x) DO k=kts,kte !qnbca2(k)=d(k-kts+1) @@ -4914,7 +4871,7 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & !============================================ ! Ozone - local mixing only !============================================ - +IF (FLAG_OZONE) THEN k=kts !rho-weighted: @@ -4944,6 +4901,9 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & !ozone2(k)=d(k-kts+1) dozone(k)=(x(k)-ozone(k))/delt ENDDO +ELSE + dozone(:)=0.0 +ENDIF !!============================================ !! Compute tendencies and convert to mixing ratios for WRF. @@ -4976,9 +4936,6 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & sqi2(k) = 0.0 ! if sqw2 > qsat sqc2(k) = 0.0 ENDIF - !dqv(k) = (sqv2(k) - sqv(k))/delt - !dqc(k) = (sqc2(k) - sqc(k))/delt - !dqi(k) = (sqi2(k) - sqi(k))/delt ENDDO ENDIF @@ -4987,7 +4944,7 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & ! WATER VAPOR TENDENCY !===================== DO k=kts,kte - Dqv(k)=(sqv2(k)/(1.-sqv2(k)) - qv(k))/delt + Dqv(k)=(sqv2(k) - sqv(k))/delt !if (sqv2(k) < 0.0)print*,"neg qv:",sqv2(k),k ENDDO @@ -4998,7 +4955,7 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & !print*,"FLAG_QC:",FLAG_QC IF (FLAG_QC) THEN DO k=kts,kte - Dqc(k)=(sqc2(k)/(1.-sqv2(k)) - qc(k))/delt + Dqc(k)=(sqc2(k) - sqc(k))/delt !if (sqc2(k) < 0.0)print*,"neg qc:",sqc2(k),k ENDDO ELSE @@ -5026,7 +4983,7 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & !=================== IF (FLAG_QI) THEN DO k=kts,kte - Dqi(k)=(sqi2(k)/(1.-sqv2(k)) - qi(k))/delt + Dqi(k)=(sqi2(k) - sqi(k))/delt !if (sqi2(k) < 0.0)print*,"neg qi:",sqi2(k),k ENDDO ELSE @@ -5035,6 +4992,19 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & ENDDO ENDIF + !=================== + ! CLOUD SNOW TENDENCY + !=================== + IF (.false.) THEN !disabled + DO k=kts,kte + Dqs(k)=(sqs2(k) - sqs(k))/delt + ENDDO + ELSE + DO k=kts,kte + Dqs(k) = 0. + ENDDO + ENDIF + !=================== ! CLOUD ICE NUM CONC TENDENCY !=================== @@ -5051,17 +5021,18 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & ELSE !-MIX CLOUD SPECIES? !CLOUDS ARE NOT NIXED (when bl_mynn_cloudmix == 0) DO k=kts,kte - Dqc(k)=0. + Dqc(k) =0. Dqnc(k)=0. - Dqi(k)=0. + Dqi(k) =0. Dqni(k)=0. + Dqs(k) =0. ENDDO ENDIF !ensure non-negative moist species - CALL moisture_check(kte, delt, delp, exner, & - sqv2, sqc2, sqi2, thl, & - dqv, dqc, dqi, dth ) + CALL moisture_check(kte, delt, delp, exner, & + sqv2, sqc2, sqi2, sqs2, thl, & + dqv, dqc, dqi, dqs, dth ) !===================== ! OZONE TENDENCY CHECK @@ -5077,8 +5048,8 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & !=================== IF (FLAG_QI) THEN DO k=kts,kte - Dth(k)=(thl(k) + xlvcp/exner(k)*sqc2(k) & - & + xlscp/exner(k)*sqi2(k) & + Dth(k)=(thl(k) + xlvcp/exner(k)*sqc2(k) & + & + xlscp/exner(k)*(sqi2(k)+sqs(k)) & & - th(k))/delt !Use form from Tripoli and Cotton (1981) with their !suggested min temperature to improve accuracy: @@ -5110,15 +5081,23 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & ! Ice-friendly aerosols !===================== Dqnifa(k)=(qnifa2(k) - qnifa(k))/delt - !===================== - ! Black-carbon aerosols - !===================== - Dqnbca(k)=(qnbca2(k) - qnbca(k))/delt ENDDO ELSE DO k=kts,kte Dqnwfa(k)=0. Dqnifa(k)=0. + ENDDO + ENDIF + + !======================== + ! BLACK-CARBON TENDENCIES + !======================== + IF (FLAG_QNBCA .AND. bl_mynn_mixscalars > 0) THEN + DO k=kts,kte + Dqnbca(k)=(qnbca2(k) - qnbca(k))/delt + ENDDO + ELSE + DO k=kts,kte Dqnbca(k)=0. ENDDO ENDIF @@ -5168,9 +5147,9 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & END SUBROUTINE mynn_tendencies ! ================================================================== - SUBROUTINE moisture_check(kte, delt, dp, exner, & - qv, qc, qi, th, & - dqv, dqc, dqi, dth ) + SUBROUTINE moisture_check(kte, delt, dp, exner, & + qv, qc, qi, qs, th, & + dqv, dqc, dqi, dqs, dth ) ! This subroutine was adopted from the CAM-UW ShCu scheme and ! adapted for use here. @@ -5186,33 +5165,36 @@ SUBROUTINE moisture_check(kte, delt, dp, exner, & ! applying corresponding input tendencies and corrective tendencies. implicit none - integer, intent(in) :: kte - real, intent(in) :: delt - real, dimension(kte), intent(in) :: dp, exner - real, dimension(kte), intent(inout) :: qv, qc, qi, th - real, dimension(kte), intent(inout) :: dqv, dqc, dqi, dth + integer, intent(in) :: kte + real(kind_phys), intent(in) :: delt + real(kind_phys), dimension(kte), intent(in) :: dp, exner + real(kind_phys), dimension(kte), intent(inout) :: qv, qc, qi, qs, th + real(kind_phys), dimension(kte), intent(inout) :: dqv, dqc, dqi, dqs, dth integer k - real :: dqc2, dqi2, dqv2, sum, aa, dum - real, parameter :: qvmin = 1e-20, & - qcmin = 0.0, & - qimin = 0.0 + real(kind_phys):: dqc2, dqi2, dqs2, dqv2, sum, aa, dum + real(kind_phys), parameter :: qvmin = 1e-20, & + qcmin = 0.0, & + qimin = 0.0 do k = kte, 1, -1 ! From the top to the surface dqc2 = max(0.0, qcmin-qc(k)) !qc deficit (>=0) dqi2 = max(0.0, qimin-qi(k)) !qi deficit (>=0) + dqs2 = max(0.0, qimin-qs(k)) !qs deficit (>=0) !fix tendencies dqc(k) = dqc(k) + dqc2/delt dqi(k) = dqi(k) + dqi2/delt - dqv(k) = dqv(k) - (dqc2+dqi2)/delt + dqs(k) = dqs(k) + dqs2/delt + dqv(k) = dqv(k) - (dqc2+dqi2+dqs2)/delt dth(k) = dth(k) + xlvcp/exner(k)*(dqc2/delt) + & - xlscp/exner(k)*(dqi2/delt) + xlscp/exner(k)*((dqi2+dqs2)/delt) !update species qc(k) = qc(k) + dqc2 qi(k) = qi(k) + dqi2 - qv(k) = qv(k) - dqc2 - dqi2 + qs(k) = qs(k) + dqs2 + qv(k) = qv(k) - dqc2 - dqi2 - dqs2 th(k) = th(k) + xlvcp/exner(k)*dqc2 + & - xlscp/exner(k)*dqi2 + xlscp/exner(k)*(dqi2+dqs2) !then fix qv dqv2 = max(0.0, qvmin-qv(k)) !qv deficit (>=0) @@ -5225,6 +5207,7 @@ SUBROUTINE moisture_check(kte, delt, dp, exner, & qv(k) = max(qv(k),qvmin) qc(k) = max(qc(k),qcmin) qi(k) = max(qi(k),qimin) + qs(k) = max(qs(k),qimin) end do ! Extra moisture used to satisfy 'qv(1)>=qvmin' is proportionally ! extracted from all the layers that has 'qv > 2*qvmin'. This fully @@ -5267,35 +5250,36 @@ SUBROUTINE mynn_mix_chem(kts,kte,i, & enh_mix, smoke_dbg ) !------------------------------------------------------------------- - INTEGER, INTENT(in) :: kts,kte,i - REAL, DIMENSION(kts:kte), INTENT(IN) :: dfh,dz,tcd,qcd - REAL, DIMENSION(kts:kte), INTENT(INOUT) :: rho - REAL, INTENT(IN) :: delt,flt,pblh - INTEGER, INTENT(IN) :: nchem, kdvel, ndvel - REAL, DIMENSION( kts:kte+1), INTENT(IN) :: s_aw - REAL, DIMENSION( kts:kte, nchem ), INTENT(INOUT) :: chem1 - REAL, DIMENSION( kts:kte+1,nchem), INTENT(IN) :: s_awchem - REAL, DIMENSION( ndvel ), INTENT(IN) :: vd1 - REAL, INTENT(IN) :: emis_ant_no,frp - LOGICAL, INTENT(IN) :: rrfs_sd,enh_mix,smoke_dbg + integer, intent(in) :: kts,kte,i + real(kind_phys), dimension(kts:kte), intent(in) :: dfh,dz,tcd,qcd + real(kind_phys), dimension(kts:kte), intent(inout) :: rho + real(kind_phys), intent(in) :: flt + real(kind_phys), intent(in) :: delt,pblh + integer, intent(in) :: nchem, kdvel, ndvel + real(kind_phys), dimension( kts:kte+1), intent(in) :: s_aw + real(kind_phys), dimension( kts:kte, nchem ), intent(inout) :: chem1 + real(kind_phys), dimension( kts:kte+1,nchem), intent(in) :: s_awchem + real(kind_phys), dimension( ndvel ), intent(in) :: vd1 + real(kind_phys), intent(in) :: emis_ant_no,frp + logical, intent(in) :: rrfs_sd,enh_mix,smoke_dbg !local vars - REAL, DIMENSION(kts:kte) :: dtz - REAL, DIMENSION(kts:kte) :: a,b,c,d,x - REAL :: rhs,dztop - REAL :: t,dzk - REAL :: hght - REAL :: khdz_old, khdz_back - INTEGER :: k,kk,kmaxfire ! JLS 12/21/21 - INTEGER :: ic ! Chemical array loop index + real(kind_phys), dimension(kts:kte) :: dtz + real(kind_phys), dimension(kts:kte) :: a,b,c,d,x + real(kind_phys):: rhs,dztop + real(kind_phys):: t,dzk + real(kind_phys):: hght + real(kind_phys):: khdz_old, khdz_back + integer :: k,kk,kmaxfire ! JLS 12/21/21 + integer :: ic ! Chemical array loop index - INTEGER, SAVE :: icall + integer, SAVE :: icall - REAL, DIMENSION(kts:kte) :: rhoinv - REAL, DIMENSION(kts:kte+1) :: rhoz,khdz - REAL, PARAMETER :: NO_threshold = 10.0 ! For anthropogenic sources - REAL, PARAMETER :: frp_threshold = 10.0 ! RAR 02/11/22: I increased the frp threshold to enhance mixing over big fires - REAL, PARAMETER :: pblh_threshold = 100.0 + real(kind_phys), dimension(kts:kte) :: rhoinv + real(kind_phys), dimension(kts:kte+1) :: rhoz,khdz + real(kind_phys), parameter :: NO_threshold = 10.0 ! For anthropogenic sources + real(kind_phys), parameter :: frp_threshold = 10.0 ! RAR 02/11/22: I increased the frp threshold to enhance mixing over big fires + real(kind_phys), parameter :: pblh_threshold = 100.0 dztop=.5*(dz(kte)+dz(kte-1)) @@ -5389,15 +5373,15 @@ SUBROUTINE retrieve_exchange_coeffs(kts,kte,& !------------------------------------------------------------------- - INTEGER , INTENT(in) :: kts,kte + integer , intent(in) :: kts,kte - REAL, DIMENSION(KtS:KtE), INTENT(in) :: dz,dfm,dfh + real(kind_phys), dimension(KtS:KtE), intent(in) :: dz,dfm,dfh - REAL, DIMENSION(KtS:KtE), INTENT(out) :: K_m, K_h + real(kind_phys), dimension(KtS:KtE), intent(out) :: K_m, K_h - INTEGER :: k - REAL :: dzk + integer :: k + real(kind_phys):: dzk K_m(kts)=0. K_h(kts)=0. @@ -5422,13 +5406,13 @@ SUBROUTINE tridiag(n,a,b,c,d) !------------------------------------------------------------------- - INTEGER, INTENT(in):: n - REAL, DIMENSION(n), INTENT(in) :: a,b - REAL, DIMENSION(n), INTENT(inout) :: c,d + integer, intent(in):: n + real(kind_phys), dimension(n), intent(in) :: a,b + real(kind_phys), dimension(n), intent(inout) :: c,d - INTEGER :: i - REAL :: p - REAL, DIMENSION(n) :: q + integer :: i + real(kind_phys):: p + real(kind_phys), dimension(n) :: q c(n)=0. q(1)=-c(1)/b(1) @@ -5458,10 +5442,10 @@ subroutine tridiag2(n,a,b,c,d,x) ! n - number of unknowns (levels) integer,intent(in) :: n - real, dimension(n),intent(in) :: a,b,c,d - real ,dimension(n),intent(out) :: x - real ,dimension(n) :: cp,dp - real :: m + real(kind_phys), dimension(n), intent(in) :: a,b,c,d + real(kind_phys), dimension(n), intent(out):: x + real(kind_phys), dimension(n) :: cp,dp + real(kind_phys):: m integer :: i ! initialize c-prime and d-prime @@ -5500,12 +5484,12 @@ subroutine tridiag3(kte,a,b,c,d,x) implicit none integer,intent(in) :: kte integer, parameter :: kts=1 - real, dimension(kte) :: a,b,c,d - real ,dimension(kte),intent(out) :: x + real(kind_phys), dimension(kte) :: a,b,c,d + real(kind_phys), dimension(kte), intent(out) :: x integer :: in ! integer kms,kme,kts,kte,in -! real a(kms:kme,3),c(kms:kme),x(kms:kme) +! real(kind_phys)a(kms:kme,3),c(kms:kme),x(kms:kme) do in=kte-1,kts,-1 d(in)=d(in)-c(in)*d(in+1)/b(in+1) @@ -5562,23 +5546,23 @@ SUBROUTINE GET_PBLH(KTS,KTE,zi,thetav1D,qke1D,zw1D,dz1D,landsea,kzi) !value could be found to work best in all conditions. !--------------------------------------------------------------- - INTEGER,INTENT(IN) :: KTS,KTE + integer,intent(in) :: KTS,KTE #ifdef HARDCODE_VERTICAL # define kts 1 # define kte HARDCODE_VERTICAL #endif - REAL, INTENT(OUT) :: zi - REAL, INTENT(IN) :: landsea - REAL, DIMENSION(KTS:KTE), INTENT(IN) :: thetav1D, qke1D, dz1D - REAL, DIMENSION(KTS:KTE+1), INTENT(IN) :: zw1D + real(kind_phys), intent(out) :: zi + real(kind_phys), intent(in) :: landsea + real(kind_phys), dimension(kts:kte), intent(in) :: thetav1D, qke1D, dz1D + real(kind_phys), dimension(kts:kte+1), intent(in) :: zw1D !LOCAL VARS - REAL :: PBLH_TKE,qtke,qtkem1,wt,maxqke,TKEeps,minthv - REAL :: delt_thv !delta theta-v; dependent on land/sea point - REAL, PARAMETER :: sbl_lim = 200. !upper limit of stable BL height (m). - REAL, PARAMETER :: sbl_damp = 400. !transition length for blending (m). - INTEGER :: I,J,K,kthv,ktke,kzi + real(kind_phys):: PBLH_TKE,qtke,qtkem1,wt,maxqke,TKEeps,minthv + real(kind_phys):: delt_thv !delta theta-v; dependent on land/sea point + real(kind_phys), parameter :: sbl_lim = 200. !upper limit of stable BL height (m). + real(kind_phys), parameter :: sbl_damp = 400. !transition length for blending (m). + integer :: I,J,K,kthv,ktke,kzi !Initialize KPBL (kzi) kzi = 2 @@ -5743,12 +5727,12 @@ SUBROUTINE DMP_mf( & & F_QNWFA,F_QNIFA,F_QNBCA, & & Psig_shcu, & ! output info - &nup2,ktop,maxmf,ztop, & - ! unputs for stochastic perturbations - &spp_pbl,rstoch_col ) + & maxwidth,ktop,maxmf,ztop, & + ! inputs for stochastic perturbations + & spp_pbl,rstoch_col ) ! inputs: - INTEGER, INTENT(IN) :: KTS,KTE,KPBL,momentum_opt,tke_opt,scalar_opt + integer, intent(in) :: KTS,KTE,KPBL,momentum_opt,tke_opt,scalar_opt #ifdef HARDCODE_VERTICAL # define kts 1 @@ -5756,133 +5740,138 @@ SUBROUTINE DMP_mf( & #endif ! Stochastic - INTEGER, INTENT(IN) :: spp_pbl - REAL, DIMENSION(KTS:KTE) :: rstoch_col - - REAL,DIMENSION(KTS:KTE), INTENT(IN) :: & - u,v,w,th,thl,tk,qt,qv,qc, & - exner,dz,THV,P,rho,qke,qnc,qni,qnwfa,qnifa,qnbca - REAL,DIMENSION(KTS:KTE+1), INTENT(IN) :: zw !height at full-sigma - REAL, INTENT(IN) :: dt,ust,flt,fltv,flq,flqv,pblh, & - dx,psig_shcu,landsea,ts - LOGICAL, OPTIONAL :: f_qc,f_qi,f_qnc,f_qni, & - f_qnwfa,f_qnifa,f_qnbca + integer, intent(in) :: spp_pbl + real(kind_phys), dimension(kts:kte) :: rstoch_col + + real(kind_phys),dimension(kts:kte), intent(in) :: & + &U,V,W,TH,THL,TK,QT,QV,QC, & + &exner,dz,THV,P,rho,qke,qnc,qni,qnwfa,qnifa,qnbca + real(kind_phys),dimension(kts:kte+1), intent(in) :: zw !height at full-sigma + real(kind_phys), intent(in) :: flt,fltv,flq,flqv,Psig_shcu, & + &landsea,ts,dx,dt,ust,pblh + logical, optional :: F_QC,F_QI,F_QNC,F_QNI,F_QNWFA,F_QNIFA,F_QNBCA ! outputs - updraft properties - REAL,DIMENSION(KTS:KTE), INTENT(OUT) :: edmf_a,edmf_w, & + real(kind_phys),dimension(kts:kte), intent(out) :: edmf_a,edmf_w, & & edmf_qt,edmf_thl,edmf_ent,edmf_qc !add one local edmf variable: - REAL,DIMENSION(KTS:KTE) :: edmf_th + real(kind_phys),dimension(kts:kte) :: edmf_th ! output - INTEGER, INTENT(OUT) :: nup2,ktop - REAL, INTENT(OUT) :: maxmf,ztop - ! outputs - variables needed for solver - sum ai*rho*wis_awphi - REAL,DIMENSION(KTS:KTE+1) :: s_aw,s_awthl,s_awqt, & - s_awqv,s_awqc,s_awqnc,s_awqni, & - s_awqnwfa,s_awqnifa,s_awqnbca, & - s_awu,s_awv,s_awqke,s_aw2 + integer, intent(out) :: ktop + real(kind_phys), intent(out) :: maxmf,ztop,maxwidth + ! outputs - variables needed for solver + real(kind_phys),dimension(kts:kte+1) :: s_aw, & !sum ai*rho*wis_awphi + &s_awthl,s_awqt,s_awqv,s_awqc,s_awqnc,s_awqni, & + &s_awqnwfa,s_awqnifa,s_awqnbca,s_awu,s_awv, & + &s_awqke,s_aw2 - REAL,DIMENSION(KTS:KTE), INTENT(INOUT) :: qc_bl1d,cldfra_bl1d, & - qc_bl1d_old,cldfra_bl1d_old + real(kind_phys),dimension(kts:kte), intent(inout) :: & + &qc_bl1d,cldfra_bl1d,qc_bl1d_old,cldfra_bl1d_old - INTEGER, PARAMETER :: nup=10, debug_mf=0 + integer, parameter :: nup=8, debug_mf=0 + real(kind_phys) :: nup2 !------------- local variables ------------------- ! updraft properties defined on interfaces (k=1 is the top of the ! first model layer - REAL,DIMENSION(KTS:KTE+1,1:NUP) :: UPW,UPTHL,UPQT,UPQC,UPQV, & - UPA,UPU,UPV,UPTHV,UPQKE,UPQNC, & - UPQNI,UPQNWFA,UPQNIFA,UPQNBCA + real(kind_phys),dimension(kts:kte+1,1:NUP) :: & + &UPW,UPTHL,UPQT,UPQC,UPQV, & + &UPA,UPU,UPV,UPTHV,UPQKE,UPQNC, & + &UPQNI,UPQNWFA,UPQNIFA,UPQNBCA ! entrainment variables - REAL,DIMENSION(KTS:KTE,1:NUP) :: ENT,ENTf - INTEGER,DIMENSION(KTS:KTE,1:NUP) :: ENTi + real(kind_phys),dimension(kts:kte,1:NUP) :: ENT,ENTf + integer,dimension(kts:kte,1:NUP) :: ENTi ! internal variables - INTEGER :: K,I,k50 - REAL :: fltv2,wstar,qstar,thstar,sigmaW,sigmaQT,sigmaTH,z0, & - pwmin,pwmax,wmin,wmax,wlv,Psig_w,maxw,maxqc,wpbl - REAL :: B,QTn,THLn,THVn,QCn,Un,Vn,QKEn,QNCn,QNIn, & - QNWFAn,QNIFAn,QNBCAn, & - Wn2,Wn,EntEXP,EntEXM,EntW,BCOEFF,THVkm1,THVk,Pk,rho_int + integer :: K,I,k50 + real(kind_phys):: fltv2,wstar,qstar,thstar,sigmaW,sigmaQT, & + &sigmaTH,z0,pwmin,pwmax,wmin,wmax,wlv,Psig_w,maxw,maxqc,wpbl + real(kind_phys):: B,QTn,THLn,THVn,QCn,Un,Vn,QKEn,QNCn,QNIn, & + & QNWFAn,QNIFAn,QNBCAn, & + & Wn2,Wn,EntEXP,EntEXM,EntW,BCOEFF,THVkm1,THVk,Pk,rho_int ! w parameters - REAL,PARAMETER :: & - &Wa=2./3., & - &Wb=0.002, & + real(kind_phys), parameter :: & + &Wa=2./3., & + &Wb=0.002, & &Wc=1.5 ! Lateral entrainment parameters ( L0=100 and ENT0=0.1) were taken from ! Suselj et al (2013, jas). Note that Suselj et al (2014,waf) use L0=200 and ENT0=0.2. - REAL,PARAMETER :: & - & L0=100., & - & ENT0=0.1 - - ! Implement ideas from Neggers (2016, JAMES): - REAL, PARAMETER :: Atot = 0.10 ! Maximum total fractional area of all updrafts - REAL, PARAMETER :: lmax = 1000.! diameter of largest plume - REAL, PARAMETER :: dl = 100. ! diff size of each plume - the differential multiplied by the integrand - REAL, PARAMETER :: dcut = 1.2 ! max diameter of plume to parameterize relative to dx (km) - REAL :: d != -2.3 to -1.7 ;=-1.9 in Neggers paper; power law exponent for number density (N=Cl^d). + real(kind_phys),parameter :: & + & L0=100., & + & ENT0=0.1 + + ! Parameters/variables for regulating plumes: + real(kind_phys), parameter :: Atot = 0.10 ! Maximum total fractional area of all updrafts + real(kind_phys), parameter :: lmax = 1000.! diameter of largest plume (absolute maximum, can be smaller) + real(kind_phys), parameter :: lmin = 300. ! diameter of smallest plume (absolute minimum, can be larger) + real(kind_phys), parameter :: dlmin = 0. ! delta increase in the diameter of smallest plume (large fltv) + real(kind_phys) :: minwidth ! actual width of smallest plume + real(kind_phys) :: dl ! variable increment of plume size + real(kind_phys), parameter :: dcut = 1.2 ! max diameter of plume to parameterize relative to dx (km) + real(kind_phys):: d != -2.3 to -1.7 ;=-1.9 in Neggers paper; power law exponent for number density (N=Cl^d). ! Note that changing d to -2.0 makes each size plume equally contribute to the total coverage of all plumes. ! Note that changing d to -1.7 doubles the area coverage of the largest plumes relative to the smallest plumes. - REAL :: cn,c,l,n,an2,hux,maxwidth,wspd_pbl,cloud_base,width_flx + real(kind_phys):: cn,c,l,n,an2,hux,wspd_pbl,cloud_base,width_flx ! chem/smoke - INTEGER, INTENT(IN) :: nchem - REAL,DIMENSION(:, :) :: chem1 - REAL,DIMENSION(kts:kte+1, nchem) :: s_awchem - REAL,DIMENSION(nchem) :: chemn - REAL,DIMENSION(KTS:KTE+1,1:NUP, nchem) :: UPCHEM - INTEGER :: ic - REAL,DIMENSION(KTS:KTE+1, nchem) :: edmf_chem - LOGICAL, INTENT(IN) :: mix_chem + integer, intent(in) :: nchem + real(kind_phys),dimension(:, :) :: chem1 + real(kind_phys),dimension(kts:kte+1, nchem) :: s_awchem + real(kind_phys),dimension(nchem) :: chemn + real(kind_phys),dimension(kts:kte+1,1:NUP, nchem) :: UPCHEM + integer :: ic + real(kind_phys),dimension(kts:kte+1, nchem) :: edmf_chem + logical, intent(in) :: mix_chem !JOE: add declaration of ERF - REAL :: ERF + real(kind_phys):: ERF - LOGICAL :: superadiabatic + logical :: superadiabatic ! VARIABLES FOR CHABOUREAU-BECHTOLD CLOUD FRACTION - REAL,DIMENSION(KTS:KTE), INTENT(INOUT) :: vt, vq, sgm - REAL :: sigq,xl,rsl,cpm,a,qmq,mf_cf,Aup,Q1,diffqt,qsat_tk,& - Fng,qww,alpha,beta,bb,f,pt,t,q2p,b9,satvp,rhgrid, & + real(kind_phys),dimension(kts:kte), intent(inout) :: vt, vq, sgm + real(kind_phys):: sigq,xl,rsl,cpm,a,qmq,mf_cf,Aup,Q1,diffqt,qsat_tk,& + Fng,qww,alpha,beta,bb,f,pt,t,q2p,b9,satvp,rhgrid, & Ac_mf,Ac_strat,qc_mf - REAL, PARAMETER :: cf_thresh = 0.5 ! only overwrite stratus CF less than this value + real(kind_phys), parameter :: cf_thresh = 0.5 ! only overwrite stratus CF less than this value ! Variables for plume interpolation/saturation check - REAL,DIMENSION(KTS:KTE) :: exneri,dzi - REAL :: THp, QTp, QCp, QCs, esat, qsl - REAL :: csigma,acfac,ac_wsp,ac_cld + real(kind_phys),dimension(kts:kte) :: exneri,dzi,rhoz + real(kind_phys):: THp, QTp, QCp, QCs, esat, qsl + real(kind_phys):: csigma,acfac,ac_wsp !plume overshoot - INTEGER :: overshoot - REAL :: bvf, Frz, dzp + integer :: overshoot + real(kind_phys):: bvf, Frz, dzp !Flux limiter: not let mass-flux of heat between k=1&2 exceed (fluxportion)*(surface heat flux). !This limiter makes adjustments to the entire column. - REAL :: adjustment, flx1 - REAL, PARAMETER :: fluxportion=0.75 ! set liberally, so has minimal impact. 0.5 starts to have a noticeable impact + real(kind_phys):: adjustment, flx1 + real(kind_phys), parameter :: fluxportion=0.75 ! set liberally, so has minimal impact. Note that + ! 0.5 starts to have a noticeable impact ! over land (decrease maxMF by 10-20%), but no impact over water. !Subsidence - REAL,DIMENSION(KTS:KTE) :: sub_thl,sub_sqv,sub_u,sub_v, & !tendencies due to subsidence - det_thl,det_sqv,det_sqc,det_u,det_v, & !tendencied due to detrainment - envm_a,envm_w,envm_thl,envm_sqv,envm_sqc, & + real(kind_phys),dimension(kts:kte) :: sub_thl,sub_sqv,sub_u,sub_v, & !tendencies due to subsidence + det_thl,det_sqv,det_sqc,det_u,det_v, & !tendencied due to detrainment + envm_a,envm_w,envm_thl,envm_sqv,envm_sqc, & envm_u,envm_v !environmental variables defined at middle of layer - REAL,DIMENSION(KTS:KTE+1) :: envi_a,envi_w !environmental variables defined at model interface - REAL :: temp,sublim,qc_ent,qv_ent,qt_ent,thl_ent,detrate, & - detrateUV,oow,exc_fac,aratio,detturb,qc_grid,qc_sgs,& - qc_plume,exc_heat,exc_moist,tk_int - REAL, PARAMETER :: Cdet = 1./45. - REAL, PARAMETER :: dzpmax = 300. !limit dz used in detrainment - can be excessing in thick layers + real(kind_phys),dimension(kts:kte+1) :: envi_a,envi_w !environmental variables defined at model interface + real(kind_phys):: temp,sublim,qc_ent,qv_ent,qt_ent,thl_ent,detrate, & + detrateUV,oow,exc_fac,aratio,detturb,qc_grid,qc_sgs, & + qc_plume,exc_heat,exc_moist,tk_int,tvs + real(kind_phys), parameter :: Cdet = 1./45. + real(kind_phys), parameter :: dzpmax = 300. !limit dz used in detrainment - can be excessing in thick layers !parameter "Csub" determines the propotion of upward vertical velocity that contributes to !environmenatal subsidence. Some portion is expected to be compensated by downdrafts instead of !gentle environmental subsidence. 1.0 assumes all upward vertical velocity in the mass-flux scheme !is compensated by "gentle" environmental subsidence. - REAL, PARAMETER :: Csub=0.25 + real(kind_phys), parameter :: Csub=0.25 !Factor for the pressure gradient effects on momentum transport - REAL, PARAMETER :: pgfac = 0.00 ! Zhang and Wu showed 0.4 is more appropriate for lower troposphere - REAL :: Uk,Ukm1,Vk,Vkm1,dxsa + real(kind_phys), parameter :: pgfac = 0.00 ! Zhang and Wu showed 0.4 is more appropriate for lower troposphere + real(kind_phys):: Uk,Ukm1,Vk,Vkm1,dxsa ! check the inputs ! print *,'dt',dt @@ -5912,9 +5901,9 @@ SUBROUTINE DMP_mf( & UPQNWFA=0. UPQNIFA=0. UPQNBCA=0. - IF ( mix_chem ) THEN - UPCHEM(KTS:KTE+1,1:NUP,1:nchem)=0.0 - ENDIF + if ( mix_chem ) then + UPCHEM(kts:kte+1,1:NUP,1:nchem)=0.0 + endif ENT=0.001 ! Initialize mean updraft properties @@ -5924,9 +5913,9 @@ SUBROUTINE DMP_mf( & edmf_thl=0. edmf_ent=0. edmf_qc =0. - IF ( mix_chem ) THEN + if ( mix_chem ) then edmf_chem(kts:kte+1,1:nchem) = 0.0 - ENDIF + endif ! Initialize the variables needed for implicit solver s_aw=0. @@ -5942,153 +5931,163 @@ SUBROUTINE DMP_mf( & s_awqnwfa=0. s_awqnifa=0. s_awqnbca=0. - IF ( mix_chem ) THEN + if ( mix_chem ) then s_awchem(kts:kte+1,1:nchem) = 0.0 - ENDIF + endif ! Initialize explicit tendencies for subsidence & detrainment sub_thl = 0. sub_sqv = 0. - sub_u = 0. - sub_v = 0. + sub_u = 0. + sub_v = 0. det_thl = 0. det_sqv = 0. det_sqc = 0. - det_u = 0. - det_v = 0. + det_u = 0. + det_v = 0. + nup2 = nup !start with nup, but set to zero if activation criteria fails ! Taper off MF scheme when significant resolved-scale motions ! are present This function needs to be asymetric... - k = 1 - maxw = 0.0 + maxw = 0.0 cloud_base = 9000.0 -! DO WHILE (ZW(k) < pblh + 500.) - DO k=1,kte-1 - IF(zw(k) > pblh + 500.) exit + do k=1,kte-1 + if (zw(k) > pblh + 500.) exit wpbl = w(k) - IF(w(k) < 0.)wpbl = 2.*w(k) - maxw = MAX(maxw,ABS(wpbl)) + if (w(k) < 0.)wpbl = 2.*w(k) + maxw = max(maxw,abs(wpbl)) !Find highest k-level below 50m AGL - IF(ZW(k)<=50.)k50=k + if (ZW(k)<=50.)k50=k !Search for cloud base - qc_sgs = MAX(qc(k), qc_bl1d(k)*cldfra_bl1d(k)) - IF(qc_sgs> 1E-5 .AND. cloud_base == 9000.0)THEN + qc_sgs = max(qc(k), qc_bl1d(k)) + if (qc_sgs> 1E-5 .and. (cldfra_bl1d(k) .ge. 0.5) .and. cloud_base == 9000.0) then cloud_base = 0.5*(ZW(k)+ZW(k+1)) - ENDIF + endif + enddo - !k = k + 1 - ENDDO - !print*," maxw before manipulation=", maxw - maxw = MAX(0.,maxw - 1.0) ! do nothing for small w (< 1 m/s), but - Psig_w = MAX(0.0, 1.0 - maxw) ! linearly taper off for w > 1.0 m/s - Psig_w = MIN(Psig_w, Psig_shcu) - !print*," maxw=", maxw," Psig_w=",Psig_w," Psig_shcu=",Psig_shcu + !do nothing for small w (< 1 m/s), but linearly taper off for w > 1.0 m/s + maxw = max(0.,maxw - 1.0) + Psig_w = max(0.0, 1.0 - maxw) + Psig_w = min(Psig_w, Psig_shcu) !Completely shut off MF scheme for strong resolved-scale vertical velocities. fltv2 = fltv - IF(Psig_w == 0.0 .and. fltv > 0.0) fltv2 = -1.*fltv + if(Psig_w == 0.0 .and. fltv > 0.0) fltv2 = -1.*fltv ! If surface buoyancy is positive we do integration, otherwise no. ! Also, ensure that it is at least slightly superadiabatic up through 50 m superadiabatic = .false. - IF((landsea-1.5).GE.0)THEN + if ((landsea-1.5).ge.0) then hux = -0.001 ! WATER ! dT/dz must be < - 0.1 K per 100 m. - ELSE + else hux = -0.005 ! LAND ! dT/dz must be < - 0.5 K per 100 m. - ENDIF - DO k=1,MAX(1,k50-1) !use "-1" because k50 used interface heights (zw). - IF (k == 1) then - IF ((th(k)-ts)/(0.5*dz(k)) < hux) THEN + endif + tvs = ts*(1.0+p608*qv(kts)) + do k=1,max(1,k50-1) !use "-1" because k50 used interface heights (zw). + if (k == 1) then + if ((thv(k)-tvs)/(0.5*dz(k)) < hux) then superadiabatic = .true. - ELSE + else superadiabatic = .false. exit - ENDIF - ELSE - IF ((th(k)-th(k-1))/(0.5*(dz(k)+dz(k-1))) < hux) THEN + endif + else + if ((thv(k)-thv(k-1))/(0.5*(dz(k)+dz(k-1))) < hux) then superadiabatic = .true. - ELSE + else superadiabatic = .false. exit - ENDIF - ENDIF - ENDDO + endif + endif + enddo ! Determine the numer of updrafts/plumes in the grid column: ! Some of these criteria may be a little redundant but useful for bullet-proofing. - ! (1) largest plume = 1.0 * dx. - ! (2) Apply a scale-break, assuming no plumes with diameter larger than PBLH can exist. + ! (1) largest plume = 1.2 * dx. + ! (2) Apply a scale-break, assuming no plumes with diameter larger than 1.1*PBLH can exist. ! (3) max plume size beneath clouds deck approx = 0.5 * cloud_base. ! (4) add wspd-dependent limit, when plume model breaks down. (hurricanes) ! (5) limit to reduce max plume sizes in weakly forced conditions. This is only ! meant to "soften" the activation of the mass-flux scheme. ! Criteria (1) - NUP2 = max(1,min(NUP,INT(dx*dcut/dl))) + maxwidth = min(dx*dcut, lmax) !Criteria (2) - maxwidth = 1.1*PBLH + maxwidth = min(maxwidth, 1.1_kind_phys*PBLH) ! Criteria (3) - maxwidth = MIN(maxwidth,0.5*cloud_base) + if ((landsea-1.5) .lt. 0) then !land + maxwidth = MIN(maxwidth, 0.5_kind_phys*cloud_base) + else !water + maxwidth = MIN(maxwidth, 0.9_kind_phys*cloud_base) + endif ! Criteria (4) - wspd_pbl=SQRT(MAX(u(kts)**2 + v(kts)**2, 0.01)) + wspd_pbl=SQRT(MAX(u(kts)**2 + v(kts)**2, 0.01_kind_phys)) !Note: area fraction (acfac) is modified below ! Criteria (5) - only a function of flt (not fltv) if ((landsea-1.5).LT.0) then !land - !width_flx = MAX(MIN(1000.*(0.6*tanh((flt - 0.050)/0.03) + .5),1000.), 0.) - width_flx = MAX(MIN(1000.*(0.6*tanh((flt - 0.040)/0.03) + .5),1000.), 0.) + width_flx = MAX(MIN(1000.*(0.6*tanh((fltv - 0.040)/0.04) + .5),1000._kind_phys), 0._kind_phys) else !water - width_flx = MAX(MIN(1000.*(0.6*tanh((flt - 0.003)/0.01) + .5),1000.), 0.) + width_flx = MAX(MIN(1000.*(0.6*tanh((fltv - 0.007)/0.02) + .5),1000._kind_phys), 0._kind_phys) + endif + maxwidth = MIN(maxwidth, width_flx) + minwidth = lmin + !allow min plume size to increase in large flux conditions (eddy diffusivity should be + !large enough to handle the representation of small plumes). + if (maxwidth .ge. (lmax - 1.0) .and. fltv .gt. 0.2)minwidth = lmin + dlmin*min((fltv-0.2)/0.3, 1._kind_phys) + + if (maxwidth .le. minwidth) then ! deactivate MF component + nup2 = 0 + maxwidth = 0.0 endif - maxwidth = MIN(maxwidth,width_flx) - ! Convert maxwidth to number of plumes - NUP2 = MIN(MAX(INT((maxwidth - MOD(maxwidth,100.))/100), 0), NUP2) - !Initialize values for 2d output fields: - ktop = 0 - ztop = 0.0 - maxmf= 0.0 + ! Initialize values for 2d output fields: + ktop = 0 + ztop = 0.0 + maxmf= 0.0 - IF ( fltv2 > 0.002 .AND. NUP2 .GE. 1 .AND. superadiabatic) then - !PRINT*," Conditions met to run mass-flux scheme",fltv2,pblh +!Begin plume processing if passes criteria +if ( fltv2 > 0.002 .AND. (maxwidth > minwidth) .AND. superadiabatic) then ! Find coef C for number size density N cn = 0. - d=-1.9 !set d to value suggested by Neggers 2015 (JAMES). - !d=-1.9 + .2*tanh((fltv2 - 0.05)/0.15) - do I=1,NUP !NUP2 - IF(I > NUP2) exit - l = dl*I ! diameter of plume + d =-1.9 !set d to value suggested by Neggers 2015 (JAMES). + dl = (maxwidth - minwidth)/real(nup-1,kind=kind_phys) + do i=1,NUP + ! diameter of plume + l = minwidth + dl*real(i-1) cn = cn + l**d * (l*l)/(dx*dx) * dl ! sum fractional area of each plume enddo C = Atot/cn !Normalize C according to the defined total fraction (Atot) ! Make updraft area (UPA) a function of the buoyancy flux if ((landsea-1.5).LT.0) then !land - !acfac = .5*tanh((fltv2 - 0.03)/0.09) + .5 - !acfac = .5*tanh((fltv2 - 0.02)/0.09) + .5 acfac = .5*tanh((fltv2 - 0.02)/0.05) + .5 else !water acfac = .5*tanh((fltv2 - 0.01)/0.03) + .5 endif !add a windspeed-dependent adjustment to acfac that tapers off - !the mass-flux scheme linearly above sfc wind speeds of 20 m/s: - ac_wsp = 1.0 - min(max(wspd_pbl - 20.0, 0.0), 10.0)/10.0 - !reduce area fraction beneath cloud bases < 1200 m AGL - ac_cld = min(cloud_base/1200., 1.0) - acfac = acfac * min(ac_wsp, ac_cld) + !the mass-flux scheme linearly above sfc wind speeds of 10 m/s. + !Note: this effect may be better represented by an increase in + !entrainment rate for high wind consitions (more ambient turbulence). + if (wspd_pbl .le. 10.) then + ac_wsp = 1.0 + else + ac_wsp = 1.0 - min((wspd_pbl - 10.0)/15., 1.0) + endif + acfac = acfac * ac_wsp ! Find the portion of the total fraction (Atot) of each plume size: An2 = 0. - do I=1,NUP !NUP2 - IF(I > NUP2) exit - l = dl*I ! diameter of plume + do i=1,NUP + ! diameter of plume + l = minwidth + dl*real(i-1) N = C*l**d ! number density of plume n - UPA(1,I) = N*l*l/(dx*dx) * dl ! fractional area of plume n + UPA(1,i) = N*l*l/(dx*dx) * dl ! fractional area of plume n - UPA(1,I) = UPA(1,I)*acfac - An2 = An2 + UPA(1,I) ! total fractional area of all plumes + UPA(1,i) = UPA(1,i)*acfac + An2 = An2 + UPA(1,i) ! total fractional area of all plumes !print*," plume size=",l,"; area=",UPA(1,I),"; total=",An2 end do @@ -6101,23 +6100,25 @@ SUBROUTINE DMP_mf( & qstar=max(flq,1.0E-5)/wstar thstar=flt/wstar - IF((landsea-1.5).GE.0)THEN + if ((landsea-1.5) .ge. 0) then csigma = 1.34 ! WATER - ELSE + else csigma = 1.34 ! LAND - ENDIF + endif if (env_subs) then exc_fac = 0.0 else if ((landsea-1.5).GE.0) then !water: increase factor to compensate for decreased pwmin/pwmax - exc_fac = 0.58*4.0*min(cloud_base/1000., 1.0) + exc_fac = 0.58*4.0 else !land: no need to increase factor - already sufficiently large superadiabatic layers exc_fac = 0.58 endif endif + !decrease excess for large wind speeds + exc_fac = exc_fac * ac_wsp !Note: sigmaW is typically about 0.5*wstar sigmaW =csigma*wstar*(z0/pblh)**(onethird)*(1 - 0.8*z0/pblh) @@ -6130,14 +6131,11 @@ SUBROUTINE DMP_mf( & wmax=MIN(sigmaW*pwmax,0.5) !SPECIFY SURFACE UPDRAFT PROPERTIES AT MODEL INTERFACE BETWEEN K = 1 & 2 - DO I=1,NUP !NUP2 - IF(I > NUP2) exit + do i=1,NUP wlv=wmin+(wmax-wmin)/NUP2*(i-1) !SURFACE UPDRAFT VERTICAL VELOCITY - UPW(1,I)=wmin + REAL(i)/REAL(NUP)*(wmax-wmin) - !IF (UPW(1,I) > 0.5*ZW(2)/dt) UPW(1,I) = 0.5*ZW(2)/dt - + UPW(1,I)=wmin + real(i)/real(NUP)*(wmax-wmin) UPU(1,I)=(U(KTS)*DZ(KTS+1)+U(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) UPV(1,I)=(V(KTS)*DZ(KTS+1)+V(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) UPQC(1,I)=0.0 @@ -6146,21 +6144,11 @@ SUBROUTINE DMP_mf( & exc_heat = exc_fac*UPW(1,I)*sigmaTH/sigmaW UPTHV(1,I)=(THV(KTS)*DZ(KTS+1)+THV(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) & & + exc_heat -!was UPTHL(1,I)= UPTHV(1,I)/(1.+svp1*UPQT(1,I)) !assume no saturated parcel at surface UPTHL(1,I)=(THL(KTS)*DZ(KTS+1)+THL(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) & & + exc_heat !calculate exc_moist by use of surface fluxes exc_moist=exc_fac*UPW(1,I)*sigmaQT/sigmaW - !calculate exc_moist by conserving rh: -! tk_int =(tk(kts)*dz(kts+1)+tk(kts+1)*dz(kts))/(dz(kts+1)+dz(kts)) -! pk =(p(kts)*dz(kts+1)+p(kts+1)*dz(kts))/(dz(kts+1)+dz(kts)) -! qtk =(qt(kts)*dz(kts+1)+qt(kts+1)*dz(kts))/(dz(kts)+dz(kts+1)) -! qsat_tk = qsat_blend(tk_int, pk) ! saturation water vapor mixing ratio at tk and p -! rhgrid =MAX(MIN(1.0,qtk/MAX(1.E-8,qsat_tk)),0.001) -! tk_int = tk_int + exc_heat -! qsat_tk = qsat_blend(tk_int, pk) -! exc_moist= max(rhgrid*qsat_tk - qtk, 0.0) UPQT(1,I)=(QT(KTS)*DZ(KTS+1)+QT(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1))& & +exc_moist @@ -6170,36 +6158,36 @@ SUBROUTINE DMP_mf( & UPQNWFA(1,I)=(QNWFA(KTS)*DZ(KTS+1)+QNWFA(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) UPQNIFA(1,I)=(QNIFA(KTS)*DZ(KTS+1)+QNIFA(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) UPQNBCA(1,I)=(QNBCA(KTS)*DZ(KTS+1)+QNBCA(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) - ENDDO + enddo - IF ( mix_chem ) THEN - DO I=1,NUP !NUP2 - IF(I > NUP2) exit + if ( mix_chem ) then + do i=1,NUP do ic = 1,nchem - UPCHEM(1,I,ic)=(chem1(KTS,ic)*DZ(KTS+1)+chem1(KTS+1,ic)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) + UPCHEM(1,i,ic)=(chem1(KTS,ic)*DZ(KTS+1)+chem1(KTS+1,ic)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) enddo - ENDDO - ENDIF + enddo + endif !Initialize environmental variables which can be modified by detrainment - DO k=kts,kte - envm_thl(k)=THL(k) - envm_sqv(k)=QV(k) - envm_sqc(k)=QC(k) - envm_u(k)=U(k) - envm_v(k)=V(k) - ENDDO + envm_thl(kts:kte)=THL(kts:kte) + envm_sqv(kts:kte)=QV(kts:kte) + envm_sqc(kts:kte)=QC(kts:kte) + envm_u(kts:kte)=U(kts:kte) + envm_v(kts:kte)=V(kts:kte) + do k=kts,kte-1 + rhoz(k) = (rho(k)*dz(k+1)+rho(k+1)*dz(k))/(dz(k+1)+dz(k)) + enddo + rhoz(kte) = rho(kte) !dxsa is scale-adaptive factor governing the pressure-gradient term of the momentum transport dxsa = 1. - MIN(MAX((12000.0-dx)/(12000.0-3000.0), 0.), 1.) ! do integration updraft - DO I=1,NUP !NUP2 - IF(I > NUP2) exit + do i=1,NUP QCn = 0. overshoot = 0 - l = dl*I ! diameter of plume - DO k=KTS+1,KTE-1 + l = minwidth + dl*real(i-1) ! diameter of plume + do k=kts+1,kte-1 !Entrainment from Tian and Kuang (2016) !ENT(k,i) = 0.35/(MIN(MAX(UPW(K-1,I),0.75),1.9)*l) wmin = 0.3 + l*0.0005 !* MAX(pblh-ZW(k+1), 0.0)/pblh @@ -6214,7 +6202,7 @@ SUBROUTINE DMP_mf( & ENT(k,i) = max(ENT(k,i),0.0003) !ENT(k,i) = max(ENT(k,i),0.05/ZW(k)) !not needed for Tian and Kuang - !JOE - increase entrainment for plumes extending very high. + !increase entrainment for plumes extending very high. IF(ZW(k) >= MIN(pblh+1500., 4000.))THEN ENT(k,i)=ENT(k,i) + (ZW(k)-MIN(pblh+1500.,4000.))*5.0E-6 ENDIF @@ -6339,13 +6327,10 @@ SUBROUTINE DMP_mf( & dzp = dz(k) ENDIF - !Limit very tall plumes - Wn=Wn*EXP(-MAX(ZW(k+1)-MIN(pblh+2000.,3500.),0.0)/1000.) - - !JOE- minimize the plume penetratration in stratocu-topped PBL - ! IF (fltv2 < 0.06) THEN - ! IF(ZW(k+1) >= pblh-200. .AND. qc(k) > 1e-5 .AND. I > 4) Wn=0. - ! ENDIF + !minimize the plume penetratration in stratocu-topped PBL + !IF (fltv2 < 0.06) THEN + ! IF(ZW(k+1) >= pblh-200. .AND. qc(k) > 1e-5 .AND. I > 4) Wn=0. + !ENDIF !Modify environment variables (representative of the model layer - envm*) !following the updraft dynamical detrainment of Asai and Kasahara (1967, JAS). @@ -6395,6 +6380,7 @@ SUBROUTINE DMP_mf( & exit !exit k-loop END IF ENDDO + IF (debug_mf == 1) THEN IF (MAXVAL(UPW(:,I)) > 10.0 .OR. MINVAL(UPA(:,I)) < 0.0 .OR. & MAXVAL(UPA(:,I)) > Atot .OR. NUP2 > 10) THEN @@ -6414,104 +6400,104 @@ SUBROUTINE DMP_mf( & ENDIF ENDIF ENDDO - ELSE +ELSE !At least one of the conditions was not met for activating the MF scheme. NUP2=0. - END IF !end criteria for mass-flux scheme +END IF !end criteria check for mass-flux scheme - ktop=MIN(ktop,KTE-1) ! Just to be safe... - IF (ktop == 0) THEN - ztop = 0.0 - ELSE - ztop=zw(ktop) - ENDIF - - IF(nup2 > 0) THEN +ktop=MIN(ktop,KTE-1) +IF (ktop == 0) THEN + ztop = 0.0 +ELSE + ztop=zw(ktop) +ENDIF - !Calculate the fluxes for each variable - !All s_aw* variable are == 0 at k=1 - DO i=1,NUP !NUP2 - IF(I > NUP2) exit +IF (nup2 > 0) THEN + !Calculate the fluxes for each variable + !All s_aw* variable are == 0 at k=1 + DO i=1,NUP DO k=KTS,KTE-1 - IF(k > ktop) exit - rho_int = (rho(k)*DZ(k+1)+rho(k+1)*DZ(k))/(DZ(k+1)+DZ(k)) - s_aw(k+1) = s_aw(k+1) + rho_int*UPA(K,i)*UPW(K,i)*Psig_w - s_awthl(k+1)= s_awthl(k+1) + rho_int*UPA(K,i)*UPW(K,i)*UPTHL(K,i)*Psig_w - s_awqt(k+1) = s_awqt(k+1) + rho_int*UPA(K,i)*UPW(K,i)*UPQT(K,i)*Psig_w + s_aw(k+1) = s_aw(k+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*Psig_w + s_awthl(k+1)= s_awthl(k+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPTHL(K,i)*Psig_w + s_awqt(k+1) = s_awqt(k+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPQT(K,i)*Psig_w !to conform to grid mean properties, move qc to qv in grid mean !saturated layers, so total water fluxes are preserved but !negative qc fluxes in unsaturated layers is reduced. - IF (qc(k) > 1e-12 .OR. qc(k+1) > 1e-12) then +! if (qc(k) > 1e-12 .or. qc(k+1) > 1e-12) then qc_plume = UPQC(K,i) - ELSE - qc_plume = 0.0 - ENDIF - s_awqc(k+1) = s_awqc(k+1) + rho_int*UPA(K,i)*UPW(K,i)*qc_plume*Psig_w - IF (momentum_opt > 0) THEN - s_awu(k+1) = s_awu(k+1) + rho_int*UPA(K,i)*UPW(K,i)*UPU(K,i)*Psig_w - s_awv(k+1) = s_awv(k+1) + rho_int*UPA(K,i)*UPW(K,i)*UPV(K,i)*Psig_w - ENDIF - IF (tke_opt > 0) THEN - s_awqke(k+1)= s_awqke(k+1) + rho_int*UPA(K,i)*UPW(K,i)*UPQKE(K,i)*Psig_w - ENDIF +! else +! qc_plume = 0.0 +! endif + s_awqc(k+1) = s_awqc(k+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*qc_plume*Psig_w s_awqv(k+1) = s_awqt(k+1) - s_awqc(k+1) ENDDO - ENDDO - - IF ( mix_chem ) THEN - DO k=KTS,KTE - IF(k > KTOP) exit - rho_int = (rho(k)*DZ(k+1)+rho(k+1)*DZ(k))/(DZ(k+1)+DZ(k)) - DO i=1,NUP !NUP2 - IF(I > NUP2) exit - do ic = 1,nchem - s_awchem(k+1,ic) = s_awchem(k+1,ic) + rho_int*UPA(K,i)*UPW(K,i)*UPCHEM(K,i,ic)*Psig_w - enddo - ENDDO - ENDDO - ENDIF - - IF (scalar_opt > 0) THEN - DO k=KTS,KTE - IF(k > KTOP) exit - rho_int = (rho(k)*DZ(k+1)+rho(k+1)*DZ(k))/(DZ(k+1)+DZ(k)) - DO I=1,NUP !NUP2 - IF (I > NUP2) exit - s_awqnc(k+1)= s_awqnc(K+1) + rho_int*UPA(K,i)*UPW(K,i)*UPQNC(K,i)*Psig_w - s_awqni(k+1)= s_awqni(K+1) + rho_int*UPA(K,i)*UPW(K,i)*UPQNI(K,i)*Psig_w - s_awqnwfa(k+1)= s_awqnwfa(K+1) + rho_int*UPA(K,i)*UPW(K,i)*UPQNWFA(K,i)*Psig_w - s_awqnifa(k+1)= s_awqnifa(K+1) + rho_int*UPA(K,i)*UPW(K,i)*UPQNIFA(K,i)*Psig_w - s_awqnbca(k+1)= s_awqnbca(K+1) + rho_int*UPA(K,i)*UPW(K,i)*UPQNBCA(K,i)*Psig_w - ENDDO - ENDDO - ENDIF + ENDDO + !momentum + if (momentum_opt > 0) then + do i=1,nup + do k=kts,kte-1 + s_awu(k+1) = s_awu(k+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPU(K,i)*Psig_w + s_awv(k+1) = s_awv(k+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPV(K,i)*Psig_w + enddo + enddo + endif + !tke + if (tke_opt > 0) then + do i=1,nup + do k=kts,kte-1 + s_awqke(k+1)= s_awqke(k+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPQKE(K,i)*Psig_w + enddo + enddo + endif + !chem + if ( mix_chem ) then + do k=kts,kte + do i=1,nup + do ic = 1,nchem + s_awchem(k+1,ic) = s_awchem(k+1,ic) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPCHEM(K,i,ic)*Psig_w + enddo + enddo + enddo + endif + + if (scalar_opt > 0) then + do k=kts,kte + do I=1,nup + s_awqnc(k+1) = s_awqnc(K+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPQNC(K,i)*Psig_w + s_awqni(k+1) = s_awqni(K+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPQNI(K,i)*Psig_w + s_awqnwfa(k+1)= s_awqnwfa(K+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPQNWFA(K,i)*Psig_w + s_awqnifa(k+1)= s_awqnifa(K+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPQNIFA(K,i)*Psig_w + s_awqnbca(k+1)= s_awqnbca(K+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPQNBCA(K,i)*Psig_w + enddo + enddo + endif - !Flux limiter: Check ratio of heat flux at top of first model layer - !and at the surface. Make sure estimated flux out of the top of the - !layer is < fluxportion*surface_heat_flux - IF (s_aw(kts+1) /= 0.) THEN + !Flux limiter: Check ratio of heat flux at top of first model layer + !and at the surface. Make sure estimated flux out of the top of the + !layer is < fluxportion*surface_heat_flux + IF (s_aw(kts+1) /= 0.) THEN dzi(kts) = 0.5*(DZ(kts)+DZ(kts+1)) !dz centered at model interface flx1 = MAX(s_aw(kts+1)*(TH(kts)-TH(kts+1))/dzi(kts),1.0e-5) - ELSE + ELSE flx1 = 0.0 !print*,"ERROR: s_aw(kts+1) == 0, NUP=",NUP," NUP2=",NUP2,& ! " superadiabatic=",superadiabatic," KTOP=",KTOP - ENDIF - adjustment=1.0 - !Print*,"Flux limiter in MYNN-EDMF, adjustment=",fluxportion*flt/dz(kts)/flx1 - !Print*,"flt/dz=",flt/dz(kts)," flx1=",flx1," s_aw(kts+1)=",s_aw(kts+1) - IF (flx1 > fluxportion*flt/dz(kts) .AND. flx1>0.0) THEN + ENDIF + adjustment=1.0 + !Print*,"Flux limiter in MYNN-EDMF, adjustment=",fluxportion*flt/dz(kts)/flx1 + !Print*,"flt/dz=",flt/dz(kts)," flx1=",flx1," s_aw(kts+1)=",s_aw(kts+1) + IF (flx1 > fluxportion*flt/dz(kts) .AND. flx1>0.0) THEN adjustment= fluxportion*flt/dz(kts)/flx1 - s_aw = s_aw*adjustment - s_awthl= s_awthl*adjustment - s_awqt = s_awqt*adjustment - s_awqc = s_awqc*adjustment - s_awqv = s_awqv*adjustment - s_awqnc= s_awqnc*adjustment - s_awqni= s_awqni*adjustment - s_awqnwfa= s_awqnwfa*adjustment - s_awqnifa= s_awqnifa*adjustment - s_awqnbca= s_awqnbca*adjustment + s_aw = s_aw*adjustment + s_awthl = s_awthl*adjustment + s_awqt = s_awqt*adjustment + s_awqc = s_awqc*adjustment + s_awqv = s_awqv*adjustment + s_awqnc = s_awqnc*adjustment + s_awqni = s_awqni*adjustment + s_awqnwfa = s_awqnwfa*adjustment + s_awqnifa = s_awqnifa*adjustment + s_awqnbca = s_awqnbca*adjustment IF (momentum_opt > 0) THEN s_awu = s_awu*adjustment s_awv = s_awv*adjustment @@ -6523,62 +6509,57 @@ SUBROUTINE DMP_mf( & s_awchem = s_awchem*adjustment ENDIF UPA = UPA*adjustment - ENDIF - !Print*,"adjustment=",adjustment," fluxportion=",fluxportion," flt=",flt - - !Calculate mean updraft properties for output: - !all edmf_* variables at k=1 correspond to the interface at top of first model layer - DO k=KTS,KTE-1 - IF(k > KTOP) exit - rho_int = (rho(k)*DZ(k+1)+rho(k+1)*DZ(k))/(DZ(k+1)+DZ(k)) - DO I=1,NUP !NUP2 - IF(I > NUP2) exit - edmf_a(K) =edmf_a(K) +UPA(K,i) - edmf_w(K) =edmf_w(K) +rho_int*UPA(K,i)*UPW(K,i) - edmf_qt(K) =edmf_qt(K) +rho_int*UPA(K,i)*UPQT(K,i) - edmf_thl(K)=edmf_thl(K)+rho_int*UPA(K,i)*UPTHL(K,i) - edmf_ent(K)=edmf_ent(K)+rho_int*UPA(K,i)*ENT(K,i) - edmf_qc(K) =edmf_qc(K) +rho_int*UPA(K,i)*UPQC(K,i) - ENDDO - + ENDIF + !Print*,"adjustment=",adjustment," fluxportion=",fluxportion," flt=",flt + + !Calculate mean updraft properties for output: + !all edmf_* variables at k=1 correspond to the interface at top of first model layer + do k=kts,kte-1 + do I=1,nup + edmf_a(K) =edmf_a(K) +UPA(K,i) + edmf_w(K) =edmf_w(K) +rhoz(k)*UPA(K,i)*UPW(K,i) + edmf_qt(K) =edmf_qt(K) +rhoz(k)*UPA(K,i)*UPQT(K,i) + edmf_thl(K)=edmf_thl(K)+rhoz(k)*UPA(K,i)*UPTHL(K,i) + edmf_ent(K)=edmf_ent(K)+rhoz(k)*UPA(K,i)*ENT(K,i) + edmf_qc(K) =edmf_qc(K) +rhoz(k)*UPA(K,i)*UPQC(K,i) + enddo + enddo + do k=kts,kte-1 !Note that only edmf_a is multiplied by Psig_w. This takes care of the !scale-awareness of the subsidence below: - IF (edmf_a(k)>0.) THEN - edmf_w(k)=edmf_w(k)/edmf_a(k) - edmf_qt(k)=edmf_qt(k)/edmf_a(k) - edmf_thl(k)=edmf_thl(k)/edmf_a(k) - edmf_ent(k)=edmf_ent(k)/edmf_a(k) - edmf_qc(k)=edmf_qc(k)/edmf_a(k) - edmf_a(k)=edmf_a(k)*Psig_w - - !FIND MAXIMUM MASS-FLUX IN THE COLUMN: - IF(edmf_a(k)*edmf_w(k) > maxmf) maxmf = edmf_a(k)*edmf_w(k) - ENDIF - ENDDO ! end k - - !smoke/chem - IF ( mix_chem ) THEN - DO k=kts,kte-1 - IF(k > KTOP) exit - rho_int = (rho(k)*dz(k+1)+rho(k+1)*dz(k))/(dz(k+1)+dz(k)) - DO I=1,NUP !NUP2 - IF(I > NUP2) exit + if (edmf_a(k)>0.) then + edmf_w(k)=edmf_w(k)/edmf_a(k) + edmf_qt(k)=edmf_qt(k)/edmf_a(k) + edmf_thl(k)=edmf_thl(k)/edmf_a(k) + edmf_ent(k)=edmf_ent(k)/edmf_a(k) + edmf_qc(k)=edmf_qc(k)/edmf_a(k) + edmf_a(k)=edmf_a(k)*Psig_w + !FIND MAXIMUM MASS-FLUX IN THE COLUMN: + if(edmf_a(k)*edmf_w(k) > maxmf) maxmf = edmf_a(k)*edmf_w(k) + endif + enddo ! end k + + !smoke/chem + if ( mix_chem ) then + do k=kts,kte-1 + do I=1,nup do ic = 1,nchem - edmf_chem(k,ic) = edmf_chem(k,ic) + rho_int*UPA(K,I)*UPCHEM(k,i,ic) + edmf_chem(k,ic) = edmf_chem(k,ic) + rhoz(k)*UPA(K,I)*UPCHEM(k,i,ic) enddo - ENDDO - - IF (edmf_a(k)>0.) THEN + enddo + enddo + do k=kts,kte-1 + if (edmf_a(k)>0.) then do ic = 1,nchem edmf_chem(k,ic) = edmf_chem(k,ic)/edmf_a(k) enddo - ENDIF - ENDDO ! end k - ENDIF + endif + enddo ! end k + endif - !Calculate the effects environmental subsidence. - !All envi_*variables are valid at the interfaces, like the edmf_* variables - IF (env_subs) THEN + !Calculate the effects environmental subsidence. + !All envi_*variables are valid at the interfaces, like the edmf_* variables + IF (env_subs) THEN DO k=kts+1,kte-1 !First, smooth the profiles of w & a, since sharp vertical gradients !in plume variables are not likely extended to env variables @@ -6613,18 +6594,16 @@ SUBROUTINE DMP_mf( & !calculate tendencies from subsidence and detrainment valid at the middle of !each model layer. The lowest model layer uses an assumes w=0 at the surface. dzi(kts) = 0.5*(dz(kts)+dz(kts+1)) - rho_int = (rho(kts)*dz(kts+1)+rho(kts+1)*dz(kts))/(dz(kts+1)+dz(kts)) sub_thl(kts)= 0.5*envi_w(kts)*envi_a(kts)* & - (rho(kts+1)*thl(kts+1)-rho(kts)*thl(kts))/dzi(kts)/rho_int + (rho(kts+1)*thl(kts+1)-rho(kts)*thl(kts))/dzi(kts)/rhoz(k) sub_sqv(kts)= 0.5*envi_w(kts)*envi_a(kts)* & - (rho(kts+1)*qv(kts+1)-rho(kts)*qv(kts))/dzi(kts)/rho_int + (rho(kts+1)*qv(kts+1)-rho(kts)*qv(kts))/dzi(kts)/rhoz(k) DO k=kts+1,kte-1 dzi(k) = 0.5*(dz(k)+dz(k+1)) - rho_int = (rho(k)*dz(k+1)+rho(k+1)*dz(k))/(dz(k+1)+dz(k)) sub_thl(k)= 0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & - (rho(k+1)*thl(k+1)-rho(k)*thl(k))/dzi(k)/rho_int + (rho(k+1)*thl(k+1)-rho(k)*thl(k))/dzi(k)/rhoz(k) sub_sqv(k)= 0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & - (rho(k+1)*qv(k+1)-rho(k)*qv(k))/dzi(k)/rho_int + (rho(k+1)*qv(k+1)-rho(k)*qv(k))/dzi(k)/rhoz(k) ENDDO DO k=KTS,KTE-1 @@ -6634,17 +6613,15 @@ SUBROUTINE DMP_mf( & ENDDO IF (momentum_opt > 0) THEN - rho_int = (rho(kts)*dz(kts+1)+rho(kts+1)*dz(kts))/(dz(kts+1)+dz(kts)) sub_u(kts)=0.5*envi_w(kts)*envi_a(kts)* & - (rho(kts+1)*u(kts+1)-rho(kts)*u(kts))/dzi(kts)/rho_int + (rho(kts+1)*u(kts+1)-rho(kts)*u(kts))/dzi(kts)/rhoz(k) sub_v(kts)=0.5*envi_w(kts)*envi_a(kts)* & - (rho(kts+1)*v(kts+1)-rho(kts)*v(kts))/dzi(kts)/rho_int + (rho(kts+1)*v(kts+1)-rho(kts)*v(kts))/dzi(kts)/rhoz(k) DO k=kts+1,kte-1 - rho_int = (rho(k)*dz(k+1)+rho(k+1)*dz(k))/(dz(k+1)+dz(k)) sub_u(k)=0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & - (rho(k+1)*u(k+1)-rho(k)*u(k))/dzi(k)/rho_int + (rho(k+1)*u(k+1)-rho(k)*u(k))/dzi(k)/rhoz(k) sub_v(k)=0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & - (rho(k+1)*v(k+1)-rho(k)*v(k))/dzi(k)/rho_int + (rho(k+1)*v(k+1)-rho(k)*v(k))/dzi(k)/rhoz(k) ENDDO DO k=KTS,KTE-1 @@ -6652,23 +6629,23 @@ SUBROUTINE DMP_mf( & det_v(k) = Cdet*(envm_v(k)-v(k))*envi_a(k)*Psig_w ENDDO ENDIF - ENDIF !end subsidence/env detranment + ENDIF !end subsidence/env detranment - !First, compute exner, plume theta, and dz centered at interface - !Here, k=1 is the top of the first model layer. These values do not - !need to be defined at k=kte (unused level). - DO K=KTS,KTE-1 - exneri(k) = (exner(k)*DZ(k+1)+exner(k+1)*DZ(k))/(DZ(k+1)+DZ(k)) + !First, compute exner, plume theta, and dz centered at interface + !Here, k=1 is the top of the first model layer. These values do not + !need to be defined at k=kte (unused level). + DO K=KTS,KTE-1 + exneri(k) = (exner(k)*dz(k+1)+exner(k+1)*dz(k))/(dz(k+1)+dz(k)) edmf_th(k)= edmf_thl(k) + xlvcp/exneri(k)*edmf_qc(K) - dzi(k) = 0.5*(DZ(k)+DZ(k+1)) - ENDDO + dzi(k) = 0.5*(dz(k)+dz(k+1)) + ENDDO !JOE: ADD CLDFRA_bl1d, qc_bl1d. Note that they have already been defined in ! mym_condensation. Here, a shallow-cu component is added, but no cumulus ! clouds can be added at k=1 (start loop at k=2). - DO K=KTS+1,KTE-2 - IF(k > KTOP) exit - IF(0.5*(edmf_qc(k)+edmf_qc(k-1))>0.0)THEN + do k=kts+1,kte-2 + if (k > KTOP) exit + if(0.5*(edmf_qc(k)+edmf_qc(k-1))>0.0 .and. (cldfra_bl1d(k) < cf_thresh))THEN !interpolate plume quantities to mass levels Aup = (edmf_a(k)*dzi(k-1)+edmf_a(k-1)*dzi(k))/(dzi(k-1)+dzi(k)) THp = (edmf_th(k)*dzi(k-1)+edmf_th(k-1)*dzi(k))/(dzi(k-1)+dzi(k)) @@ -6681,11 +6658,11 @@ SUBROUTINE DMP_mf( & qsl=ep_2*esat/max(1.e-7,(p(k)-ep_3*esat)) !condensed liquid in the plume on mass levels - IF (edmf_qc(k)>0.0 .AND. edmf_qc(k-1)>0.0)THEN + if (edmf_qc(k)>0.0 .and. edmf_qc(k-1)>0.0) then QCp = (edmf_qc(k)*dzi(k-1)+edmf_qc(k-1)*dzi(k))/(dzi(k-1)+dzi(k)) - ELSE - QCp = MAX(edmf_qc(k),edmf_qc(k-1)) - ENDIF + else + QCp = max(edmf_qc(k),edmf_qc(k-1)) + endif !COMPUTE CLDFRA & QC_BL FROM MASS-FLUX SCHEME and recompute vt & vq xl = xl_blend(tk(k)) ! obtain blended heat capacity @@ -6721,7 +6698,7 @@ SUBROUTINE DMP_mf( & !sigq = 3.5E-3 * Aup * 0.5*(edmf_w(k)+edmf_w(k-1)) * f ! convective component of sigma (CB2005) !sigq = SQRT(sigq**2 + sgm(k)**2) ! combined conv + stratus components !Per S.DeRoode 2009? - !sigq = 4. * Aup * (QTp - qt(k)) + !sigq = 5. * Aup * (QTp - qt(k)) sigq = 10. * Aup * (QTp - qt(k)) !constrain sigq wrt saturation: sigq = max(sigq, qsat_tk*0.02 ) @@ -6742,17 +6719,10 @@ SUBROUTINE DMP_mf( & !mf_cf = min(max(0.5 + 0.36 * atan(1.20*(Q1+0.4)),0.01),0.6) !Original CB mf_cf = min(max(0.5 + 0.36 * atan(1.55*Q1),0.01),0.6) - mf_cf = max(mf_cf, 1.75 * Aup) - mf_cf = min(mf_cf, 5.0 * Aup) + mf_cf = max(mf_cf, 1.8 * Aup) + mf_cf = min(mf_cf, 5.0 * Aup) endif - ! WA TEST 4/15/22 use fit to Aup rather than CB - !IF (Aup > 0.1) THEN - ! mf_cf = 2.5 * Aup - !ELSE - ! mf_cf = 1.8 * Aup - !ENDIF - !IF ( debug_code ) THEN ! print*,"In MYNN, StEM edmf" ! print*," CB: env qt=",qt(k)," qsat=",qsat_tk @@ -6764,30 +6734,20 @@ SUBROUTINE DMP_mf( & ! Update cloud fractions and specific humidities in grid cells ! where the mass-flux scheme is active. The specific humidities ! are converted to grid means (not in-cloud quantities). - if ((landsea-1.5).GE.0) then ! water - !don't overwrite stratus CF & qc_bl - degrades marine stratus - if (cldfra_bl1d(k) < cf_thresh) then - if (QCp * Aup > 5e-5) then - qc_bl1d(k) = 1.86 * (QCp * Aup) - 2.2e-5 - else - qc_bl1d(k) = 1.18 * (QCp * Aup) - endif - if (mf_cf .ge. Aup) then - qc_bl1d(k) = qc_bl1d(k) / mf_cf - endif - cldfra_bl1d(k) = mf_cf - Ac_mf = mf_cf + if (QCp * Aup > 5e-5) then + qc_bl1d(k) = 1.86 * (QCp * Aup) - 2.2e-5 + else + qc_bl1d(k) = 1.18 * (QCp * Aup) endif + cldfra_bl1d(k) = mf_cf + Ac_mf = mf_cf else ! land if (QCp * Aup > 5e-5) then qc_bl1d(k) = 1.86 * (QCp * Aup) - 2.2e-5 else qc_bl1d(k) = 1.18 * (QCp * Aup) endif - if (mf_cf .ge. Aup) then - qc_bl1d(k) = qc_bl1d(k) / mf_cf - endif cldfra_bl1d(k) = mf_cf Ac_mf = mf_cf endif @@ -6797,42 +6757,40 @@ SUBROUTINE DMP_mf( & !Use Bechtold and Siebesma (1998) piecewise estimation of Fng with !limits ,since they really should be recalculated after all the other changes...: !Only overwrite vt & vq in non-stratus condition - if (cldfra_bl1d(k) < cf_thresh) then - !if ((landsea-1.5).GE.0) then ! WATER - Q1=max(Q1,-2.25) - !else - ! Q1=max(Q1,-2.0) - !endif - - if (Q1 .ge. 1.0) then - Fng = 1.0 - elseif (Q1 .ge. -1.7 .and. Q1 .lt. 1.0) then - Fng = EXP(-0.4*(Q1-1.0)) - elseif (Q1 .ge. -2.5 .and. Q1 .lt. -1.7) then - Fng = 3.0 + EXP(-3.8*(Q1+1.7)) - else - Fng = min(23.9 + EXP(-1.6*(Q1+2.5)), 60.) - endif - - !link the buoyancy flux function to active clouds only (c*Aup): - vt(k) = qww - (1.5*Aup)*beta*bb*Fng - 1. - vq(k) = alpha + (1.5*Aup)*beta*a*Fng - tv0 + !if ((landsea-1.5).GE.0) then ! WATER + Q1=max(Q1,-2.25) + !else + ! Q1=max(Q1,-2.0) + !endif + + if (Q1 .ge. 1.0) then + Fng = 1.0 + elseif (Q1 .ge. -1.7 .and. Q1 .lt. 1.0) then + Fng = EXP(-0.4*(Q1-1.0)) + elseif (Q1 .ge. -2.5 .and. Q1 .lt. -1.7) then + Fng = 3.0 + EXP(-3.8*(Q1+1.7)) + else + Fng = min(23.9 + EXP(-1.6*(Q1+2.5)), 60.) endif - endif + + !link the buoyancy flux function to active clouds only (c*Aup): + vt(k) = qww - (1.5*Aup)*beta*bb*Fng - 1. + vq(k) = alpha + (1.5*Aup)*beta*a*Fng - tv0 + endif !check for (qc in plume) .and. (cldfra_bl < threshold) enddo !k-loop - ENDIF !end nup2 > 0 +ENDIF !end nup2 > 0 - !modify output (negative: dry plume, positive: moist plume) - IF (ktop > 0) THEN - maxqc = maxval(edmf_qc(1:ktop)) - IF ( maxqc < 1.E-8) maxmf = -1.0*maxmf - ENDIF +!modify output (negative: dry plume, positive: moist plume) +if (ktop > 0) then + maxqc = maxval(edmf_qc(1:ktop)) + if ( maxqc < 1.E-8) maxmf = -1.0*maxmf +endif ! -! debugging +! debugging ! -IF (edmf_w(1) > 4.0) THEN +if (edmf_w(1) > 4.0) then ! surface values print *,'flq:',flq,' fltv:',fltv2 print *,'pblh:',pblh,' wstar:',wstar @@ -6885,12 +6843,12 @@ subroutine condensation_edmf(QT,THL,P,zagl,THV,QC) ! ! zero or one condensation for edmf: calculates THV and QC ! -real,intent(in) :: QT,THL,P,zagl -real,intent(out) :: THV -real,intent(inout):: QC +real(kind_phys),intent(in) :: QT,THL,P,zagl +real(kind_phys),intent(out) :: THV +real(kind_phys),intent(inout):: QC integer :: niter,i -real :: diff,exn,t,th,qs,qcold +real(kind_phys):: diff,exn,t,th,qs,qcold ! constants used from module_model_constants.F ! p1000mb @@ -6932,7 +6890,7 @@ subroutine condensation_edmf(QT,THL,P,zagl,THV,QC) !THIS BASICALLY GIVE THE SAME RESULT AS THE PREVIOUS LINE !TH = THL + xlv/cp/EXN*QC - !THV= TH*(1. + 0.608*QT) + !THV= TH*(1. + p608*QT) !print *,'t,p,qt,qs,qc' !print *,t,p,qt,qs,qc @@ -6947,11 +6905,11 @@ subroutine condensation_edmf_r(QT,THL,P,zagl,THV,QC) ! zero or one condensation for edmf: calculates THL and QC ! similar to condensation_edmf but with different inputs ! -real,intent(in) :: QT,THV,P,zagl -real,intent(out) :: THL, QC +real(kind_phys),intent(in) :: QT,THV,P,zagl +real(kind_phys),intent(out) :: THL, QC integer :: niter,i -real :: diff,exn,t,th,qs,qcold +real(kind_phys):: diff,exn,t,th,qs,qcold ! number of iterations niter=50 @@ -6996,61 +6954,68 @@ SUBROUTINE DDMF_JPL(kts,kte,dt,zw,dz,p, & &qc_bl1d,cldfra_bl1d, & &rthraten ) - INTEGER, INTENT(IN) :: KTS,KTE,KPBL - REAL,DIMENSION(KTS:KTE), INTENT(IN) :: U,V,TH,THL,TK,QT,QV,QC,& - THV,P,rho,exner,rthraten,dz + integer, intent(in) :: KTS,KTE,KPBL + real(kind_phys), dimension(kts:kte), intent(in) :: & + U,V,TH,THL,TK,QT,QV,QC,THV,P,rho,exner,dz + real(kind_phys), dimension(kts:kte), intent(in) :: rthraten ! zw .. heights of the downdraft levels (edges of boxes) - REAL,DIMENSION(KTS:KTE+1), INTENT(IN) :: ZW - REAL, INTENT(IN) :: DT,UST,WTHL,WQT,PBLH - + real(kind_phys), dimension(kts:kte+1), intent(in) :: ZW + real(kind_phys), intent(in) :: WTHL,WQT + real(kind_phys), intent(in) :: dt,ust,pblh ! outputs - downdraft properties - REAL,DIMENSION(KTS:KTE), INTENT(OUT) :: edmf_a_dd,edmf_w_dd, & - & edmf_qt_dd,edmf_thl_dd, edmf_ent_dd,edmf_qc_dd + real(kind_phys), dimension(kts:kte), intent(out) :: & + edmf_a_dd,edmf_w_dd, & + edmf_qt_dd,edmf_thl_dd, edmf_ent_dd,edmf_qc_dd ! outputs - variables needed for solver (sd_aw - sum ai*wi, sd_awphi - sum ai*wi*phii) - REAL,DIMENSION(KTS:KTE+1) :: sd_aw, sd_awthl, sd_awqt, sd_awu, & - sd_awv, sd_awqc, sd_awqv, sd_awqke, sd_aw2 + real(kind_phys), dimension(kts:kte+1) :: & + sd_aw, sd_awthl, sd_awqt, sd_awu, & + sd_awv, sd_awqc, sd_awqv, sd_awqke, sd_aw2 - REAL,DIMENSION(KTS:KTE), INTENT(IN) :: qc_bl1d, cldfra_bl1d + real(kind_phys), dimension(kts:kte), intent(in) :: & + qc_bl1d, cldfra_bl1d - INTEGER, PARAMETER :: NDOWN=5, debug_mf=0 !fixing number of plumes to 5 + integer, parameter:: ndown = 5 ! draw downdraft starting height randomly between cloud base and cloud top - INTEGER, DIMENSION(1:NDOWN) :: DD_initK - REAL , DIMENSION(1:NDOWN) :: randNum + integer, dimension(1:NDOWN) :: DD_initK + real(kind_phys), dimension(1:NDOWN) :: randNum ! downdraft properties - REAL,DIMENSION(KTS:KTE+1,1:NDOWN) :: DOWNW,DOWNTHL,DOWNQT,& - DOWNQC,DOWNA,DOWNU,DOWNV,DOWNTHV + real(kind_phys), dimension(kts:kte+1,1:NDOWN) :: & + DOWNW,DOWNTHL,DOWNQT,DOWNQC,DOWNA,DOWNU,DOWNV,DOWNTHV ! entrainment variables - REAl,DIMENSION(KTS+1:KTE+1,1:NDOWN) :: ENT,ENTf - INTEGER,DIMENSION(KTS+1:KTE+1,1:NDOWN) :: ENTi + real(kind_phys), dimension(KTS+1:KTE+1,1:NDOWN) :: ENT,ENTf + integer, dimension(KTS+1:KTE+1,1:NDOWN) :: ENTi ! internal variables - INTEGER :: K,I,ki, kminrad, qlTop, p700_ind, qlBase - REAL :: wthv,wstar,qstar,thstar,sigmaW,sigmaQT,sigmaTH,z0, & - pwmin,pwmax,wmin,wmax,wlv,wtv,went,mindownw - REAL :: B,QTn,THLn,THVn,QCn,Un,Vn,QKEn,Wn2,Wn,THVk,Pk, & - EntEXP,EntW, Beta_dm, EntExp_M, rho_int - REAL :: jump_thetav, jump_qt, jump_thetal, & + integer :: K,I,ki, kminrad, qlTop, p700_ind, qlBase + real(kind_phys):: wthv,wstar,qstar,thstar,sigmaW,sigmaQT, & + sigmaTH,z0,pwmin,pwmax,wmin,wmax,wlv,wtv,went,mindownw + real(kind_phys):: B,QTn,THLn,THVn,QCn,Un,Vn,QKEn,Wn2,Wn, & + THVk,Pk,EntEXP,EntW,beta_dm,EntExp_M,rho_int + real(kind_phys):: jump_thetav, jump_qt, jump_thetal, & refTHL, refTHV, refQT ! DD specific internal variables - REAL :: minrad,zminrad, radflux, F0, wst_rad, wst_dd + real(kind_phys):: minrad,zminrad, radflux, F0, wst_rad, wst_dd logical :: cloudflg - - REAL :: sigq,xl,rsl,cpm,a,mf_cf,diffqt,& + real(kind_phys):: sigq,xl,rsl,cpm,a,mf_cf,diffqt, & Fng,qww,alpha,beta,bb,f,pt,t,q2p,b9,satvp,rhgrid ! w parameters - REAL,PARAMETER :: & - &Wa=1., & - &Wb=1.5,& - &Z00=100.,& - &BCOEFF=0.2 + real(kind_phys),parameter :: & + &Wa=1., Wb=1.5, Z00=100., BCOEFF=0.2 ! entrainment parameters - REAL,PARAMETER :: & - & L0=80,& - & ENT0=0.2 - + real(kind_phys),parameter :: & + &L0=80, ENT0=0.2 + !downdraft properties + real(kind_phys):: & + & dp, & !diameter of plume + & dl, & !diameter increment + & Adn !total area of downdrafts + !additional printouts for debugging + integer, parameter :: debug_mf=0 + + dl = (1000.-500.)/real(ndown) pwmin=-3. ! drawing from the negative tail -3sigma to -1sigma pwmax=-1. @@ -7109,7 +7074,7 @@ SUBROUTINE DDMF_JPL(kts,kte,dt,zw,dz,p, & do i=1,NDOWN ! downdraft starts somewhere between cloud base to cloud top ! the probability is equally distributed - DD_initK(i) = qlTop ! nint(randNum(i)*REAL(qlTop-qlBase)) + qlBase + DD_initK(i) = qlTop ! nint(randNum(i)*real(qlTop-qlBase)) + qlBase enddo ! LOOP RADFLUX @@ -7120,6 +7085,14 @@ SUBROUTINE DDMF_JPL(kts,kte,dt,zw,dz,p, & if ( radflux < 0.0 ) F0 = abs(radflux) + F0 enddo F0 = max(F0, 1.0) + + !Allow the total fractional area of the downdrafts to be proportional + !to the radiative forcing: + !for 50 W/m2, Adn = 0.10 + !for 100 W/m2, Adn = 0.15 + !for 150 W/m2, Adn = 0.20 + Adn = min( 0.05 + F0*0.001, 0.3) + !found Sc cloud and cloud not at surface, trigger downdraft if (cloudflg) then @@ -7134,14 +7107,14 @@ SUBROUTINE DDMF_JPL(kts,kte,dt,zw,dz,p, & ! call Poisson(1,NDOWN,kts+1,kte,ENTf,ENTi) - ! entrainent: Ent=Ent0/dz*P(dz/L0) - do i=1,NDOWN - do k=kts+1,kte -! ENT(k,i)=real(ENTi(k,i))*Ent0/(ZW(k+1)-ZW(k)) - ENT(k,i) = 0.002 - ENT(k,i) = min(ENT(k,i),0.9/(ZW(k+1)-ZW(k))) - enddo - enddo +! ! entrainent: Ent=Ent0/dz*P(dz/L0) +! do i=1,NDOWN +! do k=kts+1,kte +!! ENT(k,i)=real(ENTi(k,i))*Ent0/(ZW(k+1)-ZW(k)) +! ENT(k,i) = 0.002 +! ENT(k,i) = min(ENT(k,i),0.9/(ZW(k+1)-ZW(k))) +! enddo +! enddo !!![EW: INVJUMP] find 700mb height then subtract trpospheric lapse rate!!! p700_ind = MINLOC(ABS(p-70000),1)!p1D is 70000 @@ -7179,13 +7152,15 @@ SUBROUTINE DDMF_JPL(kts,kte,dt,zw,dz,p, & do I=1,NDOWN !downdraft now starts at different height ki = DD_initK(I) - wlv=wmin+(wmax-wmin)/REAL(NDOWN)*(i-1) - wtv=wmin+(wmax-wmin)/REAL(NDOWN)*i + wlv=wmin+(wmax-wmin)/real(NDOWN)*(i-1) + wtv=wmin+(wmax-wmin)/real(NDOWN)*i !DOWNW(ki,I)=0.5*(wlv+wtv) DOWNW(ki,I)=wlv + !multiply downa by cloud fraction, so it's impact will diminish if + !clouds are mixed away over the course of the longer radiation time step !DOWNA(ki,I)=0.5*ERF(wtv/(sqrt(2.)*sigmaW))-0.5*ERF(wlv/(sqrt(2.)*sigmaW)) - DOWNA(ki,I)=.1/REAL(NDOWN) + DOWNA(ki,I)=Adn/real(NDOWN) DOWNU(ki,I)=(u(ki-1)*DZ(ki) + u(ki)*DZ(ki-1)) /(DZ(ki)+DZ(ki-1)) DOWNV(ki,I)=(v(ki-1)*DZ(ki) + v(ki)*DZ(ki-1)) /(DZ(ki)+DZ(ki-1)) @@ -7212,16 +7187,21 @@ SUBROUTINE DDMF_JPL(kts,kte,dt,zw,dz,p, & enddo - !print*, " Begin integration of downdrafts:" DO I=1,NDOWN + dp = 500. + dl*real(I) ! diameter of plume (meters) !print *, "Plume # =", I,"=======================" DO k=DD_initK(I)-1,KTS+1,-1 + + !Entrainment from Tian and Kuang (2016), with constraints + wmin = 0.3 + dp*0.0005 + ENT(k,i) = 0.33/(MIN(MAX(-1.0*DOWNW(k+1,I),wmin),0.9)*dp) + !starting at the first interface level below cloud top !EntExp=exp(-ENT(K,I)*dz(k)) !EntExp_M=exp(-ENT(K,I)/3.*dz(k)) - EntExp =ENT(K,I)*dz(k) - EntExp_M=ENT(K,I)*0.333*dz(k) + EntExp =ENT(K,I)*dz(k) !for all scalars + EntExp_M=ENT(K,I)*0.333*dz(k) !test for momentum QTn =DOWNQT(k+1,I) *(1.-EntExp) + QT(k)*EntExp THLn=DOWNTHL(k+1,I)*(1.-EntExp) + THL(k)*EntExp @@ -7255,11 +7235,11 @@ SUBROUTINE DDMF_JPL(kts,kte,dt,zw,dz,p, & BCOEFF*B/mindownw)*MIN(dz(k), 250.) !Do not allow a parcel to accelerate more than 1.25 m/s over 200 m. - !Add max increase of 2.0 m/s for coarse vertical resolution. - IF (Wn < DOWNW(K+1,I) - MIN(1.25*dz(k)/200., 2.0))THEN - Wn = DOWNW(K+1,I) - MIN(1.25*dz(k)/200., 2.0) + !Add max acceleration of -2.0 m/s for coarse vertical resolution. + IF (Wn < DOWNW(K+1,I) - MIN(1.25*dz(k)/200., -2.0))THEN + Wn = DOWNW(K+1,I) - MIN(1.25*dz(k)/200., -2.0) ENDIF - !Add symmetrical max decrease in w + !Add symmetrical max decrease in velocity (less negative) IF (Wn > DOWNW(K+1,I) + MIN(1.25*dz(k)/200., 2.0))THEN Wn = DOWNW(K+1,I) + MIN(1.25*dz(k)/200., 2.0) ENDIF @@ -7305,7 +7285,6 @@ SUBROUTINE DDMF_JPL(kts,kte,dt,zw,dz,p, & ! Even though downdraft starts at different height, average all up to qlTop DO k=qlTop,KTS,-1 DO I=1,NDOWN - IF (I > NDOWN) exit edmf_a_dd(K) =edmf_a_dd(K) +DOWNA(K-1,I) edmf_w_dd(K) =edmf_w_dd(K) +DOWNA(K-1,I)*DOWNW(K-1,I) edmf_qt_dd(K) =edmf_qt_dd(K) +DOWNA(K-1,I)*DOWNQT(K-1,I) @@ -7355,9 +7334,9 @@ SUBROUTINE SCALE_AWARE(dx,PBL1,Psig_bl,Psig_shcu) ! Psig_bl tapers local mixing ! Psig_shcu tapers nonlocal mixing - REAL,INTENT(IN) :: dx,PBL1 - REAL, INTENT(OUT) :: Psig_bl,Psig_shcu - REAL :: dxdh + real(kind_phys), intent(in) :: dx,pbl1 + real(kind_phys), intent(out) :: Psig_bl,Psig_shcu + real(kind_phys) :: dxdh Psig_bl=1.0 Psig_shcu=1.0 @@ -7429,22 +7408,42 @@ FUNCTION esat_blend(t) IMPLICIT NONE - REAL, INTENT(IN):: t - REAL :: esat_blend,XC,ESL,ESI,chi - - XC=MAX(-80.,t - t0c) !note t0c = 273.15, tice is set in module mynn_common - -! For 253 < t < 273.16 K, the vapor pressures are "blended" as a function of temperature, -! using the approach of Chaboureau and Bechtold (2002), JAS, p. 2363. The resulting + real(kind_phys), intent(in):: t + real(kind_phys):: esat_blend,XC,ESL,ESI,chi + !liquid + real(kind_phys), parameter:: J0= .611583699E03 + real(kind_phys), parameter:: J1= .444606896E02 + real(kind_phys), parameter:: J2= .143177157E01 + real(kind_phys), parameter:: J3= .264224321E-1 + real(kind_phys), parameter:: J4= .299291081E-3 + real(kind_phys), parameter:: J5= .203154182E-5 + real(kind_phys), parameter:: J6= .702620698E-8 + real(kind_phys), parameter:: J7= .379534310E-11 + real(kind_phys), parameter:: J8=-.321582393E-13 + !ice + real(kind_phys), parameter:: K0= .609868993E03 + real(kind_phys), parameter:: K1= .499320233E02 + real(kind_phys), parameter:: K2= .184672631E01 + real(kind_phys), parameter:: K3= .402737184E-1 + real(kind_phys), parameter:: K4= .565392987E-3 + real(kind_phys), parameter:: K5= .521693933E-5 + real(kind_phys), parameter:: K6= .307839583E-7 + real(kind_phys), parameter:: K7= .105785160E-9 + real(kind_phys), parameter:: K8= .161444444E-12 + + XC=MAX(-80.,t - t0c) !note t0c = 273.15, tice is set in module mynn_common to 240 + +! For 240 < t < 268.16 K, the vapor pressures are "blended" as a function of temperature, +! using the approach similar to Chaboureau and Bechtold (2002), JAS, p. 2363. The resulting ! values are returned from the function. - IF (t .GE. t0c) THEN + IF (t .GE. (t0c-6.)) THEN esat_blend = J0+XC*(J1+XC*(J2+XC*(J3+XC*(J4+XC*(J5+XC*(J6+XC*(J7+XC*J8))))))) ELSE IF (t .LE. tice) THEN esat_blend = K0+XC*(K1+XC*(K2+XC*(K3+XC*(K4+XC*(K5+XC*(K6+XC*(K7+XC*K8))))))) ELSE - ESL = J0+XC*(J1+XC*(J2+XC*(J3+XC*(J4+XC*(J5+XC*(J6+XC*(J7+XC*J8))))))) - ESI = K0+XC*(K1+XC*(K2+XC*(K3+XC*(K4+XC*(K5+XC*(K6+XC*(K7+XC*K8))))))) - chi = (t0c - t)/(t0c - tice) + ESL = J0+XC*(J1+XC*(J2+XC*(J3+XC*(J4+XC*(J5+XC*(J6+XC*(J7+XC*J8))))))) + ESI = K0+XC*(K1+XC*(K2+XC*(K3+XC*(K4+XC*(K5+XC*(K6+XC*(K7+XC*K8))))))) + chi = ((t0c-6.) - t)/((t0c-6.) - tice) esat_blend = (1.-chi)*ESL + chi*ESI END IF @@ -7454,39 +7453,54 @@ END FUNCTION esat_blend !>\ingroup gsd_mynn_edmf !! This function extends function "esat" and returns a "blended" -!! saturation mixing ratio. +!! saturation mixing ratio. Tice currently set to 240 K, t0c = 273.15 K. !!\author JAYMES - FUNCTION qsat_blend(t, P, waterice) + FUNCTION qsat_blend(t, P) IMPLICIT NONE - REAL, INTENT(IN):: t, P - CHARACTER(LEN=1), OPTIONAL, INTENT(IN) :: waterice - CHARACTER(LEN=1) :: wrt - REAL :: qsat_blend,XC,ESL,ESI,RSLF,RSIF,chi - - IF ( .NOT. PRESENT(waterice) ) THEN - wrt = 'b' - ELSE - wrt = waterice - ENDIF + real(kind_phys), intent(in):: t, P + real(kind_phys):: qsat_blend,XC,ESL,ESI,RSLF,RSIF,chi + !liquid + real(kind_phys), parameter:: J0= .611583699E03 + real(kind_phys), parameter:: J1= .444606896E02 + real(kind_phys), parameter:: J2= .143177157E01 + real(kind_phys), parameter:: J3= .264224321E-1 + real(kind_phys), parameter:: J4= .299291081E-3 + real(kind_phys), parameter:: J5= .203154182E-5 + real(kind_phys), parameter:: J6= .702620698E-8 + real(kind_phys), parameter:: J7= .379534310E-11 + real(kind_phys), parameter:: J8=-.321582393E-13 + !ice + real(kind_phys), parameter:: K0= .609868993E03 + real(kind_phys), parameter:: K1= .499320233E02 + real(kind_phys), parameter:: K2= .184672631E01 + real(kind_phys), parameter:: K3= .402737184E-1 + real(kind_phys), parameter:: K4= .565392987E-3 + real(kind_phys), parameter:: K5= .521693933E-5 + real(kind_phys), parameter:: K6= .307839583E-7 + real(kind_phys), parameter:: K7= .105785160E-9 + real(kind_phys), parameter:: K8= .161444444E-12 XC=MAX(-80.,t - t0c) - IF ((t .GE. t0c) .OR. (wrt .EQ. 'w')) THEN - ESL = J0+XC*(J1+XC*(J2+XC*(J3+XC*(J4+XC*(J5+XC*(J6+XC*(J7+XC*J8))))))) + IF (t .GE. (t0c-6.)) THEN + ESL = J0+XC*(J1+XC*(J2+XC*(J3+XC*(J4+XC*(J5+XC*(J6+XC*(J7+XC*J8))))))) + ESL = min(ESL, P*0.15) ! Even with P=1050mb and T=55C, the sat. vap. pres only contributes to ~15% of total pres. qsat_blend = 0.622*ESL/max(P-ESL, 1e-5) -! ELSE IF (t .LE. 253.) THEN ELSE IF (t .LE. tice) THEN ESI = K0+XC*(K1+XC*(K2+XC*(K3+XC*(K4+XC*(K5+XC*(K6+XC*(K7+XC*K8))))))) + ESI = min(ESI, P*0.15) qsat_blend = 0.622*ESI/max(P-ESI, 1e-5) ELSE ESL = J0+XC*(J1+XC*(J2+XC*(J3+XC*(J4+XC*(J5+XC*(J6+XC*(J7+XC*J8))))))) + ESL = min(ESL, P*0.15) ESI = K0+XC*(K1+XC*(K2+XC*(K3+XC*(K4+XC*(K5+XC*(K6+XC*(K7+XC*K8))))))) + ESI = min(ESI, P*0.15) RSLF = 0.622*ESL/max(P-ESL, 1e-5) RSIF = 0.622*ESI/max(P-ESI, 1e-5) -! chi = (273.16-t)/20.16 - chi = (t0c - t)/(t0c - tice) +! chi = (268.16-t)/(268.16-240.) + chi = ((t0c-6.) - t)/((t0c-6.) - tice) qsat_blend = (1.-chi)*RSLF + chi*RSIF END IF @@ -7503,8 +7517,8 @@ FUNCTION xl_blend(t) IMPLICIT NONE - REAL, INTENT(IN):: t - REAL :: xl_blend,xlvt,xlst,chi + real(kind_phys), intent(in):: t + real(kind_phys):: xl_blend,xlvt,xlst,chi !note: t0c = 273.15, tice is set in mynn_common IF (t .GE. t0c) THEN @@ -7514,7 +7528,7 @@ FUNCTION xl_blend(t) ELSE xlvt = xlv + (cpv-cliq)*(t-t0c) !vaporization/condensation xlst = xls + (cpv-cice)*(t-t0c) !sublimation/deposition -! chi = (273.16-t)/20.16 +! chi = (273.16-t)/(273.16-240.) chi = (t0c - t)/(t0c - tice) xl_blend = (1.-chi)*xlvt + chi*xlst !blended END IF @@ -7532,12 +7546,12 @@ FUNCTION phim(zet) ! stable conditions [z/L ~ O(10)]. IMPLICIT NONE - REAL, INTENT(IN):: zet - REAL :: dummy_0,dummy_1,dummy_11,dummy_2,dummy_22,dummy_3,dummy_33,dummy_4,dummy_44,dummy_psi - REAL, PARAMETER :: am_st=6.1, bm_st=2.5, rbm_st=1./bm_st - REAL, PARAMETER :: ah_st=5.3, bh_st=1.1, rbh_st=1./bh_st - REAL, PARAMETER :: am_unst=10., ah_unst=34. - REAL :: phi_m,phim + real(kind_phys), intent(in):: zet + real(kind_phys):: dummy_0,dummy_1,dummy_11,dummy_2,dummy_22,dummy_3,dummy_33,dummy_4,dummy_44,dummy_psi + real(kind_phys), parameter :: am_st=6.1, bm_st=2.5, rbm_st=1./bm_st + real(kind_phys), parameter :: ah_st=5.3, bh_st=1.1, rbh_st=1./bh_st + real(kind_phys), parameter :: am_unst=10., ah_unst=34. + real(kind_phys):: phi_m,phim if ( zet >= 0.0 ) then dummy_0=1+zet**bm_st @@ -7553,8 +7567,8 @@ FUNCTION phim(zet) dummy_0=(1.-am_unst*zet) ! parentesis arg dummy_1=dummy_0**0.333333 ! y dummy_11=-0.33333*am_unst*dummy_0**(-0.6666667) ! dy/dzet - dummy_2 = 0.33333*(dummy_1**2.+dummy_1+1.) ! f - dummy_22 = 0.3333*dummy_11*(2.*dummy_1+1.) ! df/dzet + dummy_2 = 0.33333*(dummy_1**2.+dummy_1+1.) ! f + dummy_22 = 0.3333*dummy_11*(2.*dummy_1+1.) ! df/dzet dummy_3 = 0.57735*(2.*dummy_1+1.) ! g dummy_33 = 1.1547*dummy_11 ! dg/dzet dummy_4 = 1.5*log(dummy_2)-1.73205*atan(dummy_3)+1.813799364 !psic @@ -7584,12 +7598,12 @@ FUNCTION phih(zet) ! stable conditions [z/L ~ O(10)]. IMPLICIT NONE - REAL, INTENT(IN):: zet - REAL :: dummy_0,dummy_1,dummy_11,dummy_2,dummy_22,dummy_3,dummy_33,dummy_4,dummy_44,dummy_psi - REAL, PARAMETER :: am_st=6.1, bm_st=2.5, rbm_st=1./bm_st - REAL, PARAMETER :: ah_st=5.3, bh_st=1.1, rbh_st=1./bh_st - REAL, PARAMETER :: am_unst=10., ah_unst=34. - REAL :: phh,phih + real(kind_phys), intent(in):: zet + real(kind_phys):: dummy_0,dummy_1,dummy_11,dummy_2,dummy_22,dummy_3,dummy_33,dummy_4,dummy_44,dummy_psi + real(kind_phys), parameter :: am_st=6.1, bm_st=2.5, rbm_st=1./bm_st + real(kind_phys), parameter :: ah_st=5.3, bh_st=1.1, rbh_st=1./bh_st + real(kind_phys), parameter :: am_unst=10., ah_unst=34. + real(kind_phys):: phh,phih if ( zet >= 0.0 ) then dummy_0=1+zet**bh_st @@ -7605,8 +7619,8 @@ FUNCTION phih(zet) dummy_0=(1.-ah_unst*zet) ! parentesis arg dummy_1=dummy_0**0.333333 ! y dummy_11=-0.33333*ah_unst*dummy_0**(-0.6666667) ! dy/dzet - dummy_2 = 0.33333*(dummy_1**2.+dummy_1+1.) ! f - dummy_22 = 0.3333*dummy_11*(2.*dummy_1+1.) ! df/dzet + dummy_2 = 0.33333*(dummy_1**2.+dummy_1+1.) ! f + dummy_22 = 0.3333*dummy_11*(2.*dummy_1+1.) ! df/dzet dummy_3 = 0.57735*(2.*dummy_1+1.) ! g dummy_33 = 1.1547*dummy_11 ! dg/dzet dummy_4 = 1.5*log(dummy_2)-1.73205*atan(dummy_3)+1.813799364 !psic @@ -7629,21 +7643,23 @@ SUBROUTINE topdown_cloudrad(kts,kte,dz1,zw,xland,kpbl,PBLH, & &maxKHtopdown,KHtopdown,TKEprodTD ) !input - integer, intent(in) :: kte,kts - real, dimension(kts:kte), intent(in) :: dz1,sqc,sqi,sqw,& - thl,th1,ex1,p1,rho1,thetav,cldfra_bl1D,rthraten - real, dimension(kts:kte+1), intent(in) :: zw - real, intent(in) :: pblh,xland - integer,intent(in) :: kpbl + integer, intent(in) :: kte,kts + real(kind_phys), dimension(kts:kte), intent(in) :: dz1,sqc,sqi,sqw,& + thl,th1,ex1,p1,rho1,thetav,cldfra_bl1D + real(kind_phys), dimension(kts:kte), intent(in) :: rthraten + real(kind_phys), dimension(kts:kte+1), intent(in) :: zw + real(kind_phys), intent(in) :: pblh + real(kind_phys), intent(in) :: xland + integer , intent(in) :: kpbl !output - real, intent(out) :: maxKHtopdown - real, dimension(kts:kte), intent(out) :: KHtopdown,TKEprodTD + real(kind_phys), intent(out) :: maxKHtopdown + real(kind_phys), dimension(kts:kte), intent(out) :: KHtopdown,TKEprodTD !local - real, dimension(kts:kte) :: zfac,wscalek2,zfacent - real :: bfx0,sflux,wm2,wm3,h1,h2,bfxpbl,dthvx,tmp1 - real :: temps,templ,zl1,wstar3_2 - real :: ent_eff,radsum,radflux,we,rcldb,rvls,minrad,zminrad - real, parameter :: pfac =2.0, zfmin = 0.01, phifac=8.0 + real(kind_phys), dimension(kts:kte) :: zfac,wscalek2,zfacent + real(kind_phys) :: bfx0,sflux,wm2,wm3,h1,h2,bfxpbl,dthvx,tmp1 + real(kind_phys) :: temps,templ,zl1,wstar3_2 + real(kind_phys) :: ent_eff,radsum,radflux,we,rcldb,rvls,minrad,zminrad + real(kind_phys), parameter :: pfac =2.0, zfmin = 0.01, phifac=8.0 integer :: k,kk,kminrad logical :: cloudflg diff --git a/phys/module_bl_mynn_common.F b/phys/module_bl_mynn_common.F index 30e212454e..7d4057b27a 100644 --- a/phys/module_bl_mynn_common.F +++ b/phys/module_bl_mynn_common.F @@ -16,9 +16,9 @@ module module_bl_mynn_common ! For MPAS: ! use mpas_kind_types,only: kind_phys => RKIND ! For CCPP: -! use machine, only : kind_phys + use ccpp_kind_types, only : kind_phys ! For WRF - use module_gfs_machine, only : kind_phys +! use module_gfs_machine, only : kind_phys !WRF CONSTANTS use module_model_constants, only: & @@ -57,31 +57,35 @@ module module_bl_mynn_common ! real:: rvovrd != r_v/r_d != 1.608 ! Specified locally - real,parameter:: zero = 0.0 - real,parameter:: half = 0.5 - real,parameter:: one = 1.0 - real,parameter:: two = 2.0 - real,parameter:: onethird = 1./3. - real,parameter:: twothirds = 2./3. - real,parameter:: tref = 300.0 ! reference temperature (K) - real,parameter:: TKmin = 253.0 ! for total water conversion, Tripoli and Cotton (1981) -! real,parameter:: p1000mb=100000.0 -! real,parameter:: svp1 = 0.6112 !(kPa) -! real,parameter:: svp2 = 17.67 !(dimensionless) -! real,parameter:: svp3 = 29.65 !(K) - real,parameter:: tice = 240.0 !-33 (C), temp at saturation w.r.t. ice - real,parameter:: grav = g - real,parameter:: t0c = svpt0 != 273.15 +! Define single & double precision + integer, parameter :: sp = selected_real_kind(6, 37) + integer, parameter :: dp = selected_real_kind(15, 307) +! integer, parameter :: kind_phys = sp + real(kind_phys),parameter:: zero = 0.0 + real(kind_phys),parameter:: half = 0.5 + real(kind_phys),parameter:: one = 1.0 + real(kind_phys),parameter:: two = 2.0 + real(kind_phys),parameter:: onethird = 1./3. + real(kind_phys),parameter:: twothirds = 2./3. + real(kind_phys),parameter:: tref = 300.0 ! reference temperature (K) + real(kind_phys),parameter:: TKmin = 253.0 ! for total water conversion, Tripoli and Cotton (1981) +! real(kind_phys),parameter:: p1000mb=100000.0 +! real(kind_phys),parameter:: svp1 = 0.6112 !(kPa) +! real(kind_phys),parameter:: svp2 = 17.67 !(dimensionless) +! real(kind_phys),parameter:: svp3 = 29.65 !(K) + real(kind_phys),parameter:: tice = 240.0 !-33 (C), temp at saturation w.r.t. ice + real(kind_phys),parameter:: grav = g + real(kind_phys),parameter:: t0c = svpt0 != 273.15 ! To be derived in the init routine - real,parameter:: ep_3 = 1.-ep_2 != 0.378 - real,parameter:: gtr = grav/tref - real,parameter:: rk = cp/r_d - real,parameter:: tv0 = p608*tref - real,parameter:: tv1 = (1.+p608)*tref - real,parameter:: xlscp = (xlv+xlf)/cp - real,parameter:: xlvcp = xlv/cp - real,parameter:: g_inv = 1./grav + real(kind_phys),parameter:: ep_3 = 1.-ep_2 != 0.378 + real(kind_phys),parameter:: gtr = grav/tref + real(kind_phys),parameter:: rk = cp/r_d + real(kind_phys),parameter:: tv0 = p608*tref + real(kind_phys),parameter:: tv1 = (1.+p608)*tref + real(kind_phys),parameter:: xlscp = (xlv+xlf)/cp + real(kind_phys),parameter:: xlvcp = xlv/cp + real(kind_phys),parameter:: g_inv = 1./grav ! grav = g ! t0c = svpt0 != 273.15 @@ -94,5 +98,4 @@ module module_bl_mynn_common ! xlvcp = xlv/cp ! g_inv = 1./grav - end module module_bl_mynn_common diff --git a/phys/module_bl_mynn_wrapper.F b/phys/module_bl_mynn_wrapper.F index 8ceccab5ac..72ce6dbaaa 100644 --- a/phys/module_bl_mynn_wrapper.F +++ b/phys/module_bl_mynn_wrapper.F @@ -73,7 +73,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & initflag,restart,cycling, & & delt,dz,dxc,znt, & & u,v,w,th, & - & qv,qc,qi,qnc,qni,qnwfa,qnifa,qnbca, & + & qv,qc,qi,qs,qnc,qni,qnwfa,qnifa,qnbca, & ! & ozone, & & p,exner,rho,t3d, & & xland,ts,qsfc,ps, & @@ -89,7 +89,7 @@ SUBROUTINE mynnedmf_wrapper_run( & !--- end chem/smoke & Tsq,Qsq,Cov, & & rublten,rvblten,rthblten, & - & rqvblten,rqcblten,rqiblten, & + & rqvblten,rqcblten,rqiblten,rqsblten, & & rqncblten,rqniblten, & & rqnwfablten,rqnifablten,rqnbcablten, & ! & ro3blten, & @@ -100,7 +100,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & edmf_thl,edmf_ent,edmf_qc, & & sub_thl3d,sub_sqv3d, & & det_thl3d,det_sqv3d, & - & nupdraft,maxMF,ktop_plume, & + & maxwidth,maxMF,ztop_plume,ktop_plume, & & rthraten, & & tke_budget, bl_mynn_tkeadvect, & & bl_mynn_cloudpdf, bl_mynn_mixlength, & @@ -110,14 +110,13 @@ SUBROUTINE mynnedmf_wrapper_run( & & bl_mynn_output, bl_mynn_closure, & & bl_mynn_mixscalars, & & spp_pbl,pattern_spp_pbl, & - & flag_qc,flag_qi, & + & flag_qc,flag_qi,flag_qs, & & flag_qnc,flag_qni, & & flag_qnwfa,flag_qnifa,flag_qnbca, & & ids,ide,jds,jde,kds,kde, & & ims,ime,jms,jme,kms,kme, & & its,ite,jts,jte,kts,kte ) -! use module_gfs_machine, only : kind_phys use module_bl_mynn, only: mynn_bl_driver !------------------------------------------------------------------- @@ -161,16 +160,16 @@ SUBROUTINE mynnedmf_wrapper_run( & & bl_mynn_mixscalars, & & spp_pbl, & & tke_budget - real, intent(in) :: & + real(kind_phys), intent(in) :: & & bl_mynn_closure logical, intent(in) :: & & FLAG_QI, FLAG_QNI, FLAG_QC, FLAG_QNC, & - & FLAG_QNWFA, FLAG_QNIFA, FLAG_QNBCA + & FLAG_QS, FLAG_QNWFA, FLAG_QNIFA, FLAG_QNBCA logical, parameter :: FLAG_OZONE = .false. !MYNN-1D - REAL, intent(in) :: delt, dxc + REAL(kind_phys), intent(in) :: delt, dxc LOGICAL, intent(in) :: restart INTEGER :: i, j, k, itf, jtf, ktf, n INTEGER, intent(in) :: initflag, & @@ -179,72 +178,72 @@ SUBROUTINE mynnedmf_wrapper_run( & & ITS,ITE,JTS,JTE,KTS,KTE !MYNN-3D - real, dimension(ims:ime,kms:kme,jms:jme), intent(in) :: & + real(kind_phys), dimension(ims:ime,kms:kme,jms:jme), intent(in) :: & & u,v,w,t3d,th,rho,exner,p,dz - real, dimension(ims:ime,kms:kme,jms:jme), intent(inout) :: & - & rublten,rvblten,rthblten, & - & rqvblten,rqcblten,rqiblten, & - & rqncblten,rqniblten, & + real(kind_phys), dimension(ims:ime,kms:kme,jms:jme), intent(inout) :: & + & rublten,rvblten,rthblten, & + & rqvblten,rqcblten,rqiblten,rqsblten, & + & rqncblten,rqniblten, & & rqnwfablten,rqnifablten,rqnbcablten !,ro3blten - real, dimension(ims:ime,kms:kme,jms:jme), intent(inout) :: & + real(kind_phys), dimension(ims:ime,kms:kme,jms:jme), intent(inout) :: & & qke, qke_adv, el_pbl, sh3d, sm3d - real, dimension(ims:ime,kms:kme,jms:jme), intent(inout) :: & + real(kind_phys), dimension(ims:ime,kms:kme,jms:jme), intent(inout) :: & & Tsq, Qsq, Cov, exch_h, exch_m - real, dimension(ims:ime,kms:kme,jms:jme), intent(in) :: rthraten + real(kind_phys), dimension(ims:ime,kms:kme,jms:jme), intent(in) :: rthraten !optional 3D arrays - real, dimension(ims:ime,kms:kme,jms:jme), optional, intent(in) :: & + real(kind_phys), dimension(ims:ime,kms:kme,jms:jme), optional, intent(in) :: & & pattern_spp_pbl - real, dimension(ims:ime,kms:kme,jms:jme), optional, intent(inout) :: & + real(kind_phys), dimension(ims:ime,kms:kme,jms:jme), optional, intent(inout) :: & & qc_bl, qi_bl, cldfra_bl - real, dimension(ims:ime,kms:kme,jms:jme), optional, intent(inout) :: & - & edmf_a,edmf_w,edmf_qt, & - & edmf_thl,edmf_ent,edmf_qc, & + real(kind_phys), dimension(ims:ime,kms:kme,jms:jme), optional, intent(inout) :: & + & edmf_a,edmf_w,edmf_qt, & + & edmf_thl,edmf_ent,edmf_qc, & & sub_thl3d,sub_sqv3d,det_thl3d,det_sqv3d - real, dimension(ims:ime,kms:kme,jms:jme), optional, intent(inout) :: & + real(kind_phys), dimension(ims:ime,kms:kme,jms:jme), optional, intent(inout) :: & & dqke,qWT,qSHEAR,qBUOY,qDISS - real, dimension(ims:ime,kms:kme,jms:jme), optional, intent(inout) :: & - & qv,qc,qi,qnc,qni,qnwfa,qnifa,qnbca!,o3 + real(kind_phys), dimension(ims:ime,kms:kme,jms:jme), optional, intent(inout) :: & + & qv,qc,qi,qs,qnc,qni,qnwfa,qnifa,qnbca!,o3 !optional 2D arrays for passing into module_bl_myn.F - real, allocatable, dimension(:,:) :: & + real(kind_phys), allocatable, dimension(:,:) :: & & qc_bl2d, qi_bl2d, cldfra_bl2d, pattern_spp_pbl2d - real, allocatable, dimension(:,:) :: & - & edmf_a2d,edmf_w2d,edmf_qt2d, & - & edmf_thl2d,edmf_ent2d,edmf_qc2d, & + real(kind_phys), allocatable, dimension(:,:) :: & + & edmf_a2d,edmf_w2d,edmf_qt2d, & + & edmf_thl2d,edmf_ent2d,edmf_qc2d, & & sub_thl2d,sub_sqv2d,det_thl2d,det_sqv2d - real, allocatable, dimension(:,:) :: & + real(kind_phys), allocatable, dimension(:,:) :: & & dqke2d,qWT2d,qSHEAR2d,qBUOY2d,qDISS2d - real, allocatable, dimension(:,:) :: & - & qc2d,qi2d,qnc2d,qni2d,qnwfa2d,qnifa2d,qnbca2d!,o32d + real(kind_phys), allocatable, dimension(:,:) :: & + & qc2d,qi2d,qs2d,qnc2d,qni2d,qnwfa2d,qnifa2d,qnbca2d!,o32d !smoke/chem arrays - no if-defs in module_bl_mynn.F, so must define arrays #if (WRF_CHEM == 1) - real, dimension(ims:ime,kms:kme,jms:jme,nchem), intent(in) :: chem3d - real, dimension(ims:ime,kdvel,jms:jme, ndvel), intent(in) :: vd3d - real, dimension(ims:ime,kms:kme,nchem) :: chem - real, dimension(ims:ime,ndvel) :: vd - real, dimension(ims:ime) :: frp_mean, emis_ant_no + real(kind_phys), dimension(ims:ime,kms:kme,jms:jme,nchem), intent(in) :: chem3d + real(kind_phys), dimension(ims:ime,kdvel,jms:jme, ndvel), intent(in) :: vd3d + real(kind_phys), dimension(ims:ime,kms:kme,nchem) :: chem + real(kind_phys), dimension(ims:ime,ndvel) :: vd + real(kind_phys), dimension(ims:ime) :: frp_mean, emis_ant_no #else - real, dimension(ims:ime,kms:kme,nchem) :: chem - real, dimension(ims:ime,ndvel) :: vd - real, dimension(ims:ime) :: frp_mean, emis_ant_no + real(kind_phys), dimension(ims:ime,kms:kme,nchem) :: chem + real(kind_phys), dimension(ims:ime,ndvel) :: vd + real(kind_phys), dimension(ims:ime) :: frp_mean, emis_ant_no #endif !MYNN-2D - real, dimension(ims:ime,jms:jme), intent(in) :: & + real(kind_phys), dimension(ims:ime,jms:jme), intent(in) :: & & xland,ts,qsfc,ps,ch - real, dimension(ims:ime,jms:jme), intent(inout) :: & - & znt,pblh,maxmf,rmol,hfx,qfx,ust,wspd, & + real(kind_phys), dimension(ims:ime,jms:jme), intent(inout) :: & + & znt,pblh,maxwidth,maxmf,ztop_plume,rmol,hfx,qfx,ust,wspd, & & uoce,voce - integer, dimension(ims:ime,jms:jme), intent(inout) :: & - & kpbl,nupdraft,ktop_plume + integer, dimension(ims:ime,jms:jme), intent(inout) :: & + & kpbl,ktop_plume !Local - real, dimension(ims:ime,kms:kme) :: delp,sqv,sqc,sqi - real, dimension(ims:ime) :: dx - logical, parameter :: debug = .false. - real, dimension(ims:ime,kms:kme,jms:jme) :: ozone,r03blten + real(kind_phys), dimension(ims:ime,kms:kme) :: delp,sqv,sqc,sqi,sqs,ikzero + real(kind_phys), dimension(ims:ime) :: dx + logical, parameter :: debug = .false. + real(kind_phys), dimension(ims:ime,kms:kme,jms:jme) :: ozone,rO3blten !write(0,*)"==============================================" !write(0,*)"in mynn wrapper..." @@ -257,7 +256,8 @@ SUBROUTINE mynnedmf_wrapper_run( & !For now, initialized bogus array ozone=0.0 - r03blten=0.0 + rO3blten=0.0 + ikzero=0.0 !Allocate any arrays being used if (icloud_bl > 0) then @@ -303,6 +303,10 @@ SUBROUTINE mynnedmf_wrapper_run( & allocate(qi2d(ims:ime,kms:kme)) qi2d=0.0 endif + if (flag_qs) then + allocate(qs2d(ims:ime,kms:kme)) + qs2d=0.0 + endif if (flag_qnc) then allocate(qnc2d(ims:ime,kms:kme)) qnc2d=0.0 @@ -363,6 +367,13 @@ SUBROUTINE mynnedmf_wrapper_run( & enddo enddo endif + if (flag_qs) then + do k=kts,ktf + do i=its,itf + qs2d(i,k) = qs(i,k,j) + enddo + enddo + endif if (flag_qnc) then do k=kts,ktf do i=its,itf @@ -429,12 +440,6 @@ SUBROUTINE mynnedmf_wrapper_run( & ! First, create pressure differences (delp) across model layers do i=its,itf dx(i)=dxc -! delp(i,1) = ps(i,j) - (p(i,2,j)*dz(i,1,j) + p(i,1,j)*dz(i,2,j))/(dz(i,1,j)+dz(i,2,j)) -! do k=2,kte-1 -! delp(i,k) = (p(i,k,j)*dz(i,k-1,j) + p(i,k-1,j)*dz(i,k,j))/(dz(i,k,j)+dz(i,k-1,j)) - & -! (p(i,k+1,j)*dz(i,k,j) + p(i,k,j)*dz(i,k+1,j))/(dz(i,k,j)+dz(i,k+1,j)) -! enddo -! delp(i,kte) = delp(i,kte-1) enddo ! do i=its,itf @@ -445,17 +450,30 @@ SUBROUTINE mynnedmf_wrapper_run( & ! enddo !In WRF, mixing ratio is incoming. Convert to specific humidity: - do k=kts,ktf - do i=its,itf + do k=kts,ktf + do i=its,itf sqv(i,k)=qv(i,k,j)/(1.0 + qv(i,k,j)) sqc(i,k)=qc2d(i,k)/(1.0 + qv(i,k,j)) - sqi(i,k)=qi2d(i,k)/(1.0 + qv(i,k,j)) enddo enddo - -! do i=its,ite -! ts(i,j)=tsurf(i,j)/exner(i,1,j) !theta -! enddo + if (flag_qi) then + do k=kts,ktf + do i=its,itf + sqi(i,k)=qi2d(i,k)/(1.0 + qv(i,k,j)) + enddo + enddo + else + sqi(:,:)=0.0 + endif + if (flag_qs) then + do k=kts,ktf + do i=its,itf + sqs(i,k)=qs2d(i,k)/(1.0 + qv(i,k,j)) + enddo + enddo + else + sqs(:,:)=0.0 + endif if (debug) then print* @@ -503,8 +521,8 @@ SUBROUTINE mynnedmf_wrapper_run( & & delt=delt,dz=dz(:,:,j),dx=dx,znt=znt(:,j), & & u=u(:,:,j),v=v(:,:,j),w=w(:,:,j), & & th=th(:,:,j),sqv3D=sqv,sqc3D=sqc, & - & sqi3D=sqi,qnc=qnc2d,qni=qni2d, & - & qnwfa=qnwfa2d,qnifa=qnifa2d, & + & sqi3D=sqi,sqs3D=sqs,qnc=qnc2d,qni=qni2d, & + & qnwfa=qnwfa2d,qnifa=qnifa2d,qnbca=qnbca2d, & & ozone=ozone(:,:,j), & & p=p(:,:,j),exner=exner(:,:,j),rho=rho(:,:,j), & & T3D=t3d(:,:,j),xland=xland(:,j), & @@ -524,10 +542,11 @@ SUBROUTINE mynnedmf_wrapper_run( & & RTHBLTEN=RTHBLTEN(:,:,j),RQVBLTEN=RQVBLTEN(:,:,j), & !output & RQCBLTEN=rqcblten(:,:,j),RQIBLTEN=rqiblten(:,:,j), & !output & RQNCBLTEN=rqncblten(:,:,j),RQNIBLTEN=rqniblten(:,:,j), & !output + & RQSBLTEN=ikzero, & !there is no RQSBLTEN, so use dummy arary & RQNWFABLTEN=RQNWFABLTEN(:,:,j), & !output & RQNIFABLTEN=RQNIFABLTEN(:,:,j), & !output & RQNBCABLTEN=RQNBCABLTEN(:,:,j), & !output - & dozone=r03blten(:,:,j), & !output + & dozone=rO3blten(:,:,j), & !output & EXCH_H=exch_h(:,:,j),EXCH_M=exch_m(:,:,j), & !output & pblh=pblh(:,j),KPBL=KPBL(:,j), & !output & el_pbl=el_pbl(:,:,j), & !output @@ -551,14 +570,14 @@ SUBROUTINE mynnedmf_wrapper_run( & & edmf_ent=edmf_ent2d,edmf_qc=edmf_qc2d, & !output & sub_thl3D=sub_thl2d,sub_sqv3D=sub_sqv2d, & !output & det_thl3D=det_thl2d,det_sqv3D=det_sqv2d, & !output - & nupdraft=nupdraft(:,j),maxMF=maxMF(:,j), & !output - & ktop_plume=ktop_plume(:,j), & !output + & maxwidth=maxwidth(:,j),maxMF=maxMF(:,j), & !output + & ztop_plume=ztop_plume(:,j),ktop_plume=ktop_plume(:,j), & !output & spp_pbl=spp_pbl,pattern_spp_pbl=pattern_spp_pbl2d, & !input & RTHRATEN=rthraten(:,:,j), & !input - & FLAG_QI=flag_qi,FLAG_QNI=flag_qni, & !input + & FLAG_QI=flag_qi,FLAG_QNI=flag_qni,FLAG_QS=flag_qs, & !input & FLAG_QC=flag_qc,FLAG_QNC=flag_qnc, & !input & FLAG_QNWFA=FLAG_QNWFA,FLAG_QNIFA=FLAG_QNIFA, & !input - & FLAG_QNBCA=FLAG_QNBCA, & !input + & FLAG_QNBCA=FLAG_QNBCA,FLAG_OZONE=flag_ozone, & !input & IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde, & !input & IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme, & !input & ITS=its,ITE=itf,JTS=jts,JTE=jtf,KTS=kts,KTE=kte) !input @@ -572,13 +591,20 @@ SUBROUTINE mynnedmf_wrapper_run( & RQIBLTEN(i,k,j) = RQIBLTEN(i,k,j)/(1.0 - sqv(i,k)) enddo enddo + if (.false.) then !as of now, there is no RQSBLTEN in WRF + do k=kts,ktf + do i=its,itf + RQSBLTEN(i,k,j) = RQSBLTEN(i,k,j)/(1.0 - sqv(i,k)) + enddo + enddo + endif !- Collect 3D ouput: if (icloud_bl > 0) then do k=kts,ktf do i=its,itf - qc_bl(i,k,j) = qc_bl2d(i,k) - qi_bl(i,k,j) = qi_bl2d(i,k) + qc_bl(i,k,j) = qc_bl2d(i,k)/(1.0 - sqv(i,k)) + qi_bl(i,k,j) = qi_bl2d(i,k)/(1.0 - sqv(i,k)) cldfra_bl(i,k,j) = cldfra_bl2d(i,k) enddo enddo @@ -648,8 +674,7 @@ SUBROUTINE mynnedmf_wrapper_run( & print*,"dudt:",rublten(its,1,j),rublten(its,2,j),rublten(its,kte,j) print*,"dvdt:",rvblten(its,1,j),rvblten(its,2,j),rvblten(its,kte,j) print*,"dqdt:",rqvblten(its,1,j),rqvblten(its,2,j),rqvblten(its,kte,j) - print*,"ktop_plume:",ktop_plume(its,j)," maxmf:",maxmf(its,j) - print*,"nup:",nupdraft(its,j) + print*,"ztop_plume:",ztop_plume(its,j)," maxmf:",maxmf(its,j) print* endif @@ -682,6 +707,7 @@ SUBROUTINE mynnedmf_wrapper_run( & endif if (flag_qc) deallocate(qc2d) if (flag_qi) deallocate(qi2d) + if (flag_qs) deallocate(qs2d) if (flag_qnc) deallocate(qnc2d) if (flag_qni) deallocate(qni2d) if (flag_qnwfa)deallocate(qnwfa2d) diff --git a/phys/module_pbl_driver.F b/phys/module_pbl_driver.F index fd2075f45b..bdcf4660b4 100644 --- a/phys/module_pbl_driver.F +++ b/phys/module_pbl_driver.F @@ -53,7 +53,7 @@ SUBROUTINE pbl_driver( & ,sub_thl3D,sub_sqv3D & ,det_thl3D,det_sqv3D & ,vdfg & - ,nupdraft,maxMF,ktop_plume & + ,maxwidth,maxMF,ztop_plume,ktop_plume & ,spp_pbl,pattern_spp_pbl & ! EEPS ,pek,pep,pek_adv,pep_adv & @@ -585,9 +585,9 @@ SUBROUTINE pbl_driver( & & INTENT(INOUT):: vdfg INTEGER, OPTIONAL, DIMENSION( ims:ime , jms:jme ), & - & INTENT(OUT) :: nupdraft,ktop_plume + & INTENT(OUT) :: ktop_plume REAL, OPTIONAL, DIMENSION( ims:ime , jms:jme ), & - & INTENT(OUT) :: maxMF + & INTENT(OUT) :: maxwidth,maxMF,ztop_plume REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), & INTENT(INOUT) :: qnwfa_curr,qnifa_curr,qnbca_curr @@ -1638,7 +1638,7 @@ SUBROUTINE pbl_driver( & &initflag=initflag,restart=restart,cycling=cycling, & &delt=dtbl,dz=dz8w,dxc=dx,znt=znt, & &u=u_phy,v=v_phy,w=w,th=th_phy,qv=qv_curr, & - &qc=qc_curr,qi=qi_curr, & + &qc=qc_curr,qi=qi_curr,qs=qs_curr, & &qnc=qnc_curr,qni=qni_curr, & &QNWFA=qnwfa_curr,QNIFA=qnifa_curr,QNBCA=qnbca_curr, & ! &ozone=ozone, & @@ -1658,6 +1658,7 @@ SUBROUTINE pbl_driver( & &RUBLTEN=rublten,RVBLTEN=rvblten,RTHBLTEN=rthblten, & &RQVBLTEN=rqvblten,RQCBLTEN=rqcblten,RQIBLTEN=rqiblten,& &RQNCBLTEN=rqncblten,RQNIBLTEN=rqniblten, & + &RQSBLTEN=rqsblten, & &RQNWFABLTEN=rqnwfablten,RQNIFABLTEN=rqnifablten, & &RQNBCABLTEN=rqnbcablten, & ! &Ro3BLTEN=ro3blten, & @@ -1671,8 +1672,8 @@ SUBROUTINE pbl_driver( & &edmf_thl=edmf_thl,edmf_ent=edmf_ent,edmf_qc=edmf_qc, & &sub_thl3D=sub_thl3D,sub_sqv3D=sub_sqv3D, & &det_thl3D=det_thl3D,det_sqv3D=det_sqv3D, & - &nupdraft=nupdraft,maxMF=maxMF, & - &ktop_plume=ktop_plume, & + &maxwidth=maxwidth,maxMF=maxMF, & + &ztop_plume=ztop_plume,ktop_plume=ktop_plume, & &RTHRATEN=RTHRATEN, & &bl_mynn_tkeadvect=bl_mynn_tkeadvect, & &tke_budget=tke_budget, & @@ -1688,7 +1689,7 @@ SUBROUTINE pbl_driver( & &bl_mynn_mixqt=bl_mynn_mixqt, & &bl_mynn_closure=bl_mynn_closure, & &spp_pbl=spp_pbl,pattern_spp_pbl=pattern_spp_pbl, & - &FLAG_QC=flag_qc,FLAG_QI=flag_qi, & + &FLAG_QC=flag_qc,FLAG_QI=flag_qi,FLAG_QS=flag_qs, & &FLAG_QNC=flag_qnc,FLAG_QNI=flag_qni, & &FLAG_QNWFA=flag_qnwfa,FLAG_QNIFA=flag_qnifa, & &FLAG_QNBCA=flag_qnbca, & diff --git a/phys/module_radiation_driver.F b/phys/module_radiation_driver.F index 924c820086..c981bf7894 100644 --- a/phys/module_radiation_driver.F +++ b/phys/module_radiation_driver.F @@ -1417,10 +1417,10 @@ SUBROUTINE radiation_driver ( & DO i = its,ite DO k = kts,kte IF (qc(i,k,j) < 1.E-6 .AND. CLDFRA_BL(i,k,j) > 0.001) THEN - qc(i,k,j)=qc(i,k,j) + QC_BL(i,k,j)*CLDFRA_BL(i,k,j) + qc(i,k,j)=qc(i,k,j) + QC_BL(i,k,j) ENDIF IF (qi(i,k,j) < 1.E-8 .AND. CLDFRA_BL(i,k,j) > 0.001) THEN - qi(i,k,j)=qi(i,k,j) + QI_BL(i,k,j)*CLDFRA_BL(i,k,j) + qi(i,k,j)=qi(i,k,j) + QI_BL(i,k,j) ENDIF ENDDO ENDDO From ce1069f7babcaf9112f8fe8fd5be26ff831f7a58 Mon Sep 17 00:00:00 2001 From: Cenlin_He Date: Fri, 12 Jan 2024 18:21:49 -0700 Subject: [PATCH 30/41] Bug fix for Noah-MP snow, vegetation and urban (#1929) TYPE: bug fix KEYWORDS: Noah-MP, snow combine, vegetation fraction scaling, urban ground heat flux SOURCE: Cenlin He (NCAR/RAL) DESCRIPTION OF CHANGES: There are a few bug fixes for Noah-MP related processes: (1) the snow layer index in snow COMBINE module was wrong, causing model crash when snow layer changes by more than 1 layer within one timestep; This has been fixed by using the correct layer index. (2) the ground heat flux sign in Noah-MP column model (positive: downward) is inconsistent with that in urban canopy model (positive: upward), leading to wrong diagnostic grid-mean ground heat flux calculation for urban grid. This only affects the diagnostic value for output. See this issue: https://github.com/wrf-model/WRF/issues/1921 and https://github.com/NCAR/hrldas/issues/114 (3) there is a bug in vegetation fraction (FVEG) scaling for stomata resistance calculation (https://github.com/NCAR/noahmp/issues/92) and canopy interception calculation (https://github.com/NCAR/noahmp/issues/91). LIST OF MODIFIED FILES: list of changed files (use `git diff --name-status master` to get formatted list): phys/noahmp/src/module_sf_noahmplsm.F phys/noahmp/src/module_sf_noahmpdrv.F TESTS CONDUCTED: 1. Tested successfully in NCAR Cheyenne HPC for 13-km run over the entire CONUS region 2. The Jenkins tests are all passing. RELEASE NOTE: Noah-MP bug fix for snow combination, vegetation fraction scaling, and urban ground heat flux sign. --- phys/noahmp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/phys/noahmp b/phys/noahmp index 981d4f859c..4ecebec707 160000 --- a/phys/noahmp +++ b/phys/noahmp @@ -1 +1 @@ -Subproject commit 981d4f859ce6c64213d38a783654c05b47b3485e +Subproject commit 4ecebec7072e507ed7607012e5a89379348391bf From fefb8b973fe70a24b539a29d50bc0c50326d92a8 Mon Sep 17 00:00:00 2001 From: David Robertson Date: Fri, 12 Jan 2024 21:53:21 -0500 Subject: [PATCH 31/41] Remove arbitrary limiting of heat fluxes (#1924) TYPE: bug fix KEYWORDS: surface layer, latent heat flux limit SOURCE: David Robertson, Rutgers University DESCRIPTION OF CHANGES: Problem: Arbitrary limitation in the computation of QFX and HFX in modules module_sf_sfclay.F and module_sf_sfclayrev.F that affects the computation latent heat fluxes and sensible heat flux in coastal areas that limit fog layers. Solution: The zero downward latent heat flux limit is removed. LIST OF MODIFIED FILES: M phys/module_sf_sfclay.F M phys/module_sf_sfclayrev.F TESTS CONDUCTED: - Ran the coupled WRF-ROMS standard test case for Hurricane Irene. - It passed regression tests. RELEASE NOTE: This PR removed zero negative latent heat flux limit (atmosphere to water) in the revised MM5 and original MM5 surface layer schemes. --- phys/module_sf_sfclay.F | 4 ++-- phys/module_sf_sfclayrev.F | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/phys/module_sf_sfclay.F b/phys/module_sf_sfclay.F index 2b3ba578f0..8cdaaa158c 100644 --- a/phys/module_sf_sfclay.F +++ b/phys/module_sf_sfclay.F @@ -892,7 +892,7 @@ SUBROUTINE SFCLAY1D(J,UX,VX,T1D,QV1D,P1D,dz8w1d, & ! DO 370 I=its,ite QFX(I)=FLQC(I)*(QSFC(I)-QX(I)) - QFX(I)=AMAX1(QFX(I),0.) +! QFX(I)=AMAX1(QFX(I),0.) LH(I)=XLV*QFX(I) 370 CONTINUE @@ -910,7 +910,7 @@ SUBROUTINE SFCLAY1D(J,UX,VX,T1D,QV1D,P1D,dz8w1d, & ! ENDIF ELSEIF(XLAND(I)-1.5.LT.0.)THEN HFX(I)=FLHC(I)*(THGB(I)-THX(I)) - HFX(I)=AMAX1(HFX(I),-250.) +! HFX(I)=AMAX1(HFX(I),-250.) ENDIF 400 CONTINUE diff --git a/phys/module_sf_sfclayrev.F b/phys/module_sf_sfclayrev.F index 9f65730122..2a3ca5a01d 100644 --- a/phys/module_sf_sfclayrev.F +++ b/phys/module_sf_sfclayrev.F @@ -1041,7 +1041,7 @@ SUBROUTINE SFCLAYREV1D(J,UX,VX,T1D,QV1D,P1D,dz8w1d, & DO 370 I=its,ite QFX(I)=FLQC(I)*(QSFC(I)-QX(I)) - QFX(I)=AMAX1(QFX(I),0.) +! QFX(I)=AMAX1(QFX(I),0.) LH(I)=XLV*QFX(I) 370 CONTINUE @@ -1059,7 +1059,7 @@ SUBROUTINE SFCLAYREV1D(J,UX,VX,T1D,QV1D,P1D,dz8w1d, & ! ENDIF ELSEIF(XLAND(I)-1.5.LT.0.)THEN HFX(I)=FLHC(I)*(THGB(I)-THX(I)) - HFX(I)=AMAX1(HFX(I),-250.) +! HFX(I)=AMAX1(HFX(I),-250.) ENDIF 400 CONTINUE From 32de5e45d0a8ae17c2e1b84ae5547a5d5abdb55a Mon Sep 17 00:00:00 2001 From: "Zhiquan (Jake) Liu" Date: Wed, 17 Jan 2024 09:24:40 -0700 Subject: [PATCH 32/41] Add the capability for assimilating GOES-ABI radiance data (#1983) TYPE: new feature KEYWORDS: ABI, cloud detection, all-sky obs error model SOURCE: JJ Guerrette (NCAR/MMM, now at tomorrow.io), Deqin Li (Liaoning Meteorological Bureau of CMA), Jake Liu (NCAR/MMM) DESCRIPTION OF CHANGES: This PR addes the assimilation of GOES-16/17 ABI's 3 water vapor channels' radiance data. This includes reading of ABI's full-disk, CONUS, and meso1&2 data files, superobbing and thinning of ABI data, IR-based cloud detection scheme as part of quality control, and all-sky obs error model. Cloud detection scheme should be the same as for AHI in principle, but the actual code implementation is not the same. No attempt made to make ABI's cloud detection code consistent with AHI's when bringing the code originally developed back in 2019-2020 into the latest develop branch. Some technical information is provided below for the use of this new capability. 1. Read ABI files: Raw netcdf ABI data files (one file for one channel) need to be listed in 4 list files: 'file_list_GOES-16-ABI_C' for CONUS scan files 'file_list_GOES-16-ABI_F' for full-disk scan files (e.g., OR_ABI-L1b-RadF-M6C08_G16_s20191211200263_e20191211209571_c20191211210021.nc) 'file_list_GOES-16-ABI_M1' for meso1 scan files 'file_list_GOES-16-ABI_M2' for meso2 scan files ABI data reading code will automatically determine which file(s) to read in matching ABI file's time and analysis time. 2. Cloud detection scheme needs to read in a terrain file OR_ABI-TERR_G16.nc or OR_ABI-TERR_G17.nc for GOES-16 ABI or GOES-17 ABI. 3. Related namelist settings: ``` &wrfvar4 use_goesabiobs = true, ! read goes-16 and goes-17 ABI data / ``` ``` &wrfvar14 rtminit_nsensor= 1, rtminit_platform= 4, ! goes rtminit_satid= 16, ! goes-16 rtminit_sensor= 44, ! abi thinning= true, thinning_mesh= 30.0, qc_rad=true, write_iv_rad_ascii=true, write_oa_rad_ascii=true, rtm_option= 2, crtm_cloud= false, only_sea_rad=false, use_varbc=true, varbc_nobsmin=500, crtm_irland_coef= "IGBP.IRland.EmisCoeff.bin", use_clddet_zz=true, ! IR-based cloud detection abi_superob_halfwidth=3, ! this will do supperobbing with 7x7 pixels / ``` See also AHI DA related PRs: https://github.com/wrf-model/WRF/pull/1139 https://github.com/wrf-model/WRF/pull/1173 https://github.com/wrf-model/WRF/pull/1774 LIST OF MODIFIED FILES: 41 M Registry/registry.var M var/build/depend.txt M var/da/da_define_structures/da_define_structures.f90 M var/da/da_monitor/da_rad_diags.f90 M var/da/da_radiance/da_allocate_rad_iv.inc M var/da/da_radiance/da_deallocate_radiance.inc M var/da/da_radiance/da_get_innov_vector_crtm.inc M var/da/da_radiance/da_get_innov_vector_rttov.inc A var/da/da_radiance/da_get_sat_angles.inc A var/da/da_radiance/da_get_sat_angles_1d.inc A var/da/da_radiance/da_get_solar_angles.inc A var/da/da_radiance/da_get_solar_angles_1d.inc M var/da/da_radiance/da_initialize_rad_iv.inc A var/da/da_radiance/da_qc_goesabi.inc M var/da/da_radiance/da_qc_rad.inc M var/da/da_radiance/da_radiance.f90 M var/da/da_radiance/da_radiance1.f90 M var/da/da_radiance/da_radiance_init.inc A var/da/da_radiance/da_read_obs_ncgoesabi.inc M var/da/da_radiance/da_rttov.f90 M var/da/da_radiance/da_setup_radiance_structures.inc M var/da/da_radiance/da_write_iv_rad_ascii.inc M var/da/da_radiance/da_write_oa_rad_ascii.inc M var/da/da_radiance/module_radiance.f90 M var/da/da_setup_structures/da_setup_obs_structures.inc M var/da/da_setup_structures/da_setup_structures.f90 A var/da/da_tools/da_llxy_1d.inc A var/da/da_tools/da_llxy_default_1d.inc A var/da/da_tools/da_llxy_global_1d.inc A var/da/da_tools/da_llxy_kma_global_1d.inc A var/da/da_tools/da_llxy_latlon_1d.inc A var/da/da_tools/da_llxy_lc_1d.inc A var/da/da_tools/da_llxy_merc_1d.inc A var/da/da_tools/da_llxy_ps_1d.inc A var/da/da_tools/da_llxy_rotated_latlon_1d.inc A var/da/da_tools/da_llxy_wrf_1d.inc A var/da/da_tools/da_togrid_1d.inc M var/da/da_tools/da_tools.f90 M var/run/VARBC.in A var/run/radiance_info/goes-16-abi.info A var/run/radiance_info/goes-17-abi.info TESTS CONDUCTED: 1. WRFDA regression test passed on Derecho. 2. Clear-sky ABI DA is tested with a full-disk data file. 3. the Jenkins tests all passing. RELEASE NOTE: Add the capability for assimilating GOES-ABI radiance data --- Registry/registry.var | 3 + var/build/depend.txt | 12 +- .../da_define_structures.f90 | 20 +- var/da/da_monitor/da_rad_diags.f90 | 48 +- var/da/da_radiance/da_allocate_rad_iv.inc | 18 +- var/da/da_radiance/da_deallocate_radiance.inc | 23 +- .../da_radiance/da_get_innov_vector_crtm.inc | 14 +- .../da_radiance/da_get_innov_vector_rttov.inc | 34 +- var/da/da_radiance/da_get_sat_angles.inc | 100 + var/da/da_radiance/da_get_sat_angles_1d.inc | 132 + var/da/da_radiance/da_get_solar_angles.inc | 215 ++ var/da/da_radiance/da_get_solar_angles_1d.inc | 253 ++ var/da/da_radiance/da_initialize_rad_iv.inc | 19 +- var/da/da_radiance/da_qc_goesabi.inc | 706 +++++ var/da/da_radiance/da_qc_rad.inc | 5 +- var/da/da_radiance/da_radiance.f90 | 12 +- var/da/da_radiance/da_radiance1.f90 | 16 +- var/da/da_radiance/da_radiance_init.inc | 46 +- var/da/da_radiance/da_read_obs_ncgoesabi.inc | 2623 +++++++++++++++++ var/da/da_radiance/da_rttov.f90 | 6 +- .../da_setup_radiance_structures.inc | 7 + var/da/da_radiance/da_write_iv_rad_ascii.inc | 13 +- var/da/da_radiance/da_write_oa_rad_ascii.inc | 11 +- var/da/da_radiance/module_radiance.f90 | 2 + .../da_setup_obs_structures.inc | 19 +- .../da_setup_structures.f90 | 2 +- var/da/da_tools/da_llxy_1d.inc | 115 + var/da/da_tools/da_llxy_default_1d.inc | 114 + var/da/da_tools/da_llxy_global_1d.inc | 35 + var/da/da_tools/da_llxy_kma_global_1d.inc | 36 + var/da/da_tools/da_llxy_latlon_1d.inc | 56 + var/da/da_tools/da_llxy_lc_1d.inc | 64 + var/da/da_tools/da_llxy_merc_1d.inc | 35 + var/da/da_tools/da_llxy_ps_1d.inc | 50 + var/da/da_tools/da_llxy_rotated_latlon_1d.inc | 60 + var/da/da_tools/da_llxy_wrf_1d.inc | 51 + var/da/da_tools/da_togrid_1d.inc | 44 + var/da/da_tools/da_tools.f90 | 13 + var/run/VARBC.in | 21 +- var/run/radiance_info/goes-16-abi.info | 11 + var/run/radiance_info/goes-17-abi.info | 11 + 41 files changed, 5026 insertions(+), 49 deletions(-) create mode 100644 var/da/da_radiance/da_get_sat_angles.inc create mode 100644 var/da/da_radiance/da_get_sat_angles_1d.inc create mode 100644 var/da/da_radiance/da_get_solar_angles.inc create mode 100644 var/da/da_radiance/da_get_solar_angles_1d.inc create mode 100644 var/da/da_radiance/da_qc_goesabi.inc create mode 100644 var/da/da_radiance/da_read_obs_ncgoesabi.inc create mode 100644 var/da/da_tools/da_llxy_1d.inc create mode 100644 var/da/da_tools/da_llxy_default_1d.inc create mode 100644 var/da/da_tools/da_llxy_global_1d.inc create mode 100644 var/da/da_tools/da_llxy_kma_global_1d.inc create mode 100644 var/da/da_tools/da_llxy_latlon_1d.inc create mode 100644 var/da/da_tools/da_llxy_lc_1d.inc create mode 100644 var/da/da_tools/da_llxy_merc_1d.inc create mode 100644 var/da/da_tools/da_llxy_ps_1d.inc create mode 100644 var/da/da_tools/da_llxy_rotated_latlon_1d.inc create mode 100644 var/da/da_tools/da_llxy_wrf_1d.inc create mode 100644 var/da/da_tools/da_togrid_1d.inc create mode 100644 var/run/radiance_info/goes-16-abi.info create mode 100644 var/run/radiance_info/goes-17-abi.info diff --git a/Registry/registry.var b/Registry/registry.var index c3da95a13d..366e1c2da0 100644 --- a/Registry/registry.var +++ b/Registry/registry.var @@ -202,6 +202,7 @@ rconfig logical use_amsr2obs namelist,wrfvar4 1 .false. - "use rconfig logical use_ahiobs namelist,wrfvar4 1 .false. - "use_ahiobs" "" "" rconfig logical use_gmiobs namelist,wrfvar4 1 .false. - "use_gmiobs" "" "" rconfig logical use_goesimgobs namelist,wrfvar4 1 .false. - "use_goesimgobs" "" "" +rconfig logical use_goesabiobs namelist,wrfvar4 1 .false. - "use_goesabiobs" "" "" rconfig logical use_kma1dvar namelist,wrfvar4 1 .false. - "use_kma1dvar" "" "" rconfig logical use_filtered_rad namelist,wrfvar4 1 .false. - "use_filtered_rad" "" "" rconfig logical use_obs_errfac namelist,wrfvar4 1 .false. - "use_obs_errfac" "" "" @@ -468,6 +469,7 @@ rconfig integer varbc_nobsmin namelist,wrfvar14 1 10 - "va rconfig integer use_clddet namelist,wrfvar14 1 2 - "use_clddet" "0: off, 1: mmr, 2: pf, 3: ecmwf" "" rconfig logical use_clddet_zz namelist,wrfvar14 1 .false. - "use_clddet_zz" "cloud detection scheme from Zhuge X. and Zou X. JAMC, 2016." "" rconfig integer ahi_superob_halfwidth namelist,wrfvar14 1 0 - "ahi_superob_halfwidth" "" "" +rconfig integer abi_superob_halfwidth namelist,wrfvar14 1 0 - "abi_superob_halfwidth" "" "" rconfig logical airs_warmest_fov namelist,wrfvar14 1 .false. - "airs_warmest_fov" "" "" rconfig logical use_satcv namelist,wrfvar14 2 .false. - "use_satcv" "" "" rconfig logical use_blacklist_rad namelist,wrfvar14 1 .true. - "use_blacklist_rad" "" "" @@ -477,6 +479,7 @@ rconfig character crtm_irwater_coef namelist,wrfvar14 1 "Nalli.IRwater rconfig character crtm_mwwater_coef namelist,wrfvar14 1 "FASTEM5.MWwater.EmisCoeff.bin" - "crtm_mwwater_coef" "" "" rconfig character crtm_irland_coef namelist,wrfvar14 1 "USGS.IRland.EmisCoeff.bin" - "crtm_irland_coef" "" "" rconfig character crtm_visland_coef namelist,wrfvar14 1 "USGS.VISland.EmisCoeff.bin" - "crtm_visland_coef" "" "" +rconfig logical abi_use_symm_obs_err namelist,wrfvar14 1 .false. - "abi_use_symm_obs_err" "" "" rconfig logical ahi_use_symm_obs_err namelist,wrfvar14 1 .false. - "ahi_use_symm_obs_err" "" "" rconfig logical ahi_apply_clrsky_bias namelist,wrfvar14 1 .false. - "ahi_apply_clrsky_bias" "" "" rconfig integer num_pseudo namelist,wrfvar15 1 0 - "num_pseudo" "" "" diff --git a/var/build/depend.txt b/var/build/depend.txt index 59e626f662..3d12fee59c 100644 --- a/var/build/depend.txt +++ b/var/build/depend.txt @@ -136,24 +136,24 @@ da_chem_sfc.o: da_chem_sfc.f90 da_jo_and_grady_chem_sfc.inc da_jo_chem_sfc.inc d da_obs_io.o : da_obs_io.f90 da_grid_definitions.o da_final_write_modified_filtered_obs.inc da_final_write_filtered_obs.inc da_write_noise_to_ob.inc da_read_omb_tmp.inc da_read_rand_unit.inc da_read_y_unit.inc da_final_write_y.inc da_final_write_obs.inc da_read_obs_bufrgpsro.inc da_read_obs_bufr.inc da_write_y.inc da_write_modified_filtered_obs.inc da_write_filtered_obs.inc da_write_obs_etkf.inc da_search_obs.inc da_read_iv_for_multi_inc.inc da_write_iv_for_multi_inc.inc da_write_obs.inc da_use_obs_errfac.inc da_read_errfac.inc da_read_obs_rain.inc da_scan_obs_rain.inc da_scan_obs_radar.inc da_read_obs_radar.inc da_scan_obs_lightning.inc da_read_obs_lightning.inc da_scan_obs_ascii.inc da_read_obs_ascii.inc da_par_util.o gsi_thinning.o module_radiance.o da_tracing.o da_tools_serial.o da_tools.o da_reporting.o da_physics.o da_par_util1.o da_obs.o da_grid_definitions.o da_define_structures.o da_control.o module_domain.o da_read_lsac_util.inc da_read_obs_lsac.inc da_scan_obs_lsac.inc da_netcdf_interface.o da_gpseph.o da_read_obs_bufrgpsro_eph.inc da_read_obs_chem_sfc.inc da_scan_obs_chem_sfc.inc da_write_obs_chem_sfc.inc da_final_write_obs_chem_sfc.inc da_final_write_obs_gas_sfc.inc da_read_obs_bufr_satwnd.inc da_par_util.o : da_par_util.f90 da_proc_maxmin_combine.inc da_proc_stats_combine.inc da_system.inc da_y_facade_to_global.inc da_generic_boilerplate.inc da_deallocate_global_synop.inc da_deallocate_global_sound.inc da_deallocate_global_sonde_sfc.inc da_generic_methods.inc da_patch_to_global_3d.inc da_patch_to_global_dual_res.inc da_patch_to_global_2d.inc da_cv_to_global.inc da_transpose_y2x_v2.inc da_transpose_x2y_v2.inc da_transpose_z2y.inc da_transpose_y2z.inc da_transpose_x2z.inc da_transpose_z2x.inc da_transpose_y2x.inc da_transpose_x2y.inc da_unpack_count_obs.inc da_pack_count_obs.inc da_copy_tile_dims.inc da_copy_dims.inc da_alloc_and_copy_be_arrays.inc da_vv_to_cv.inc da_cv_to_vv.inc da_generic_typedefs.inc da_wrf_interfaces.o da_tracing.o da_reporting.o da_define_structures.o da_par_util1.o module_dm.o module_domain.o da_control.o da_par_util1.o : da_par_util1.f90 da_proc_sum_real.inc da_proc_sum_ints.inc da_proc_sum_int.inc da_control.o module_state_description.o -da_physics.o : da_physics.f90 da_uv_to_sd_lin.inc da_uv_to_sd_adj.inc da_integrat_dz.inc da_wdt.inc da_filter_adj.inc da_filter.inc da_evapo_lin.inc da_condens_lin.inc da_condens_adj.inc da_moist_phys_lin.inc da_moist_phys_adj.inc da_sfc_pre_adj.inc da_sfc_pre_lin.inc da_sfc_pre.inc da_transform_xtowtq_adj.inc da_transform_xtowtq.inc da_transform_xtopsfc_adj.inc da_transform_xtopsfc.inc da_sfc_wtq_adj.inc da_sfc_wtq_lin.inc da_sfc_wtq.inc da_julian_day.inc da_roughness_from_lanu.inc da_get_q_error.inc da_check_rh_simple.inc da_check_rh.inc da_transform_xtogpsref_lin.inc da_transform_xtogpsref_adj.inc da_transform_xtogpsref.inc da_transform_xtotpw_adj.inc da_transform_xtotpw.inc da_transform_xtoztd_adj.inc da_transform_xtoztd_lin.inc da_transform_xtoztd.inc da_tv_profile_tl.inc da_thickness_tl.inc da_find_layer_adj.inc da_thickness.inc da_tv_profile_adj.inc da_find_layer.inc da_thickness_adj.inc da_find_layer_tl.inc da_tv_profile.inc da_tpq_to_slp_adj.inc da_tpq_to_slp_lin.inc da_wrf_tpq_2_slp.inc da_tpq_to_slp.inc da_trh_to_td.inc da_tp_to_qs_lin1.inc da_tp_to_qs_lin.inc da_tp_to_qs_adj1.inc da_tp_to_qs_adj.inc da_tp_to_qs1.inc da_tp_to_qs.inc da_tprh_to_q_lin1.inc da_tprh_to_q_lin.inc da_tprh_to_q_adj1.inc da_tprh_to_q_adj.inc da_tpq_to_rh_lin1.inc da_tpq_to_rh_lin.inc da_tpq_to_rh.inc da_pt_to_rho_lin.inc da_pt_to_rho_adj.inc da_uvprho_to_w_adj.inc da_uvprho_to_w_lin.inc da_prho_to_t_lin.inc da_prho_to_t_adj.inc da_wrf_interfaces.o da_reporting.o da_dynamics.o da_interpolation.o da_tracing.o da_par_util.o da_define_structures.o da_control.o module_comm_dm.o module_dm.o module_domain.o da_grid_definitions.o da_gpseph.o +da_physics.o : da_physics.f90 da_uv_to_sd_lin.inc da_uv_to_sd_adj.inc da_integrat_dz.inc da_wdt.inc da_filter_adj.inc da_filter.inc da_evapo_lin.inc da_condens_lin.inc da_condens_adj.inc da_moist_phys_lin.inc da_moist_phys_adj.inc da_sfc_pre_adj.inc da_sfc_pre_lin.inc da_sfc_pre.inc da_transform_xtowtq_adj.inc da_transform_xtowtq.inc da_transform_xtopsfc_adj.inc da_transform_xtopsfc.inc da_sfc_wtq_adj.inc da_sfc_wtq_lin.inc da_sfc_wtq.inc da_julian_day.inc da_roughness_from_lanu.inc da_get_q_error.inc da_check_rh_simple.inc da_check_rh.inc da_transform_xtogpsref_lin.inc da_transform_xtogpsref_adj.inc da_transform_xtogpsref.inc da_transform_xtotpw_adj.inc da_transform_xtotpw.inc da_transform_xtoztd_adj.inc da_transform_xtoztd_lin.inc da_transform_xtoztd.inc da_tv_profile_tl.inc da_thickness_tl.inc da_find_layer_adj.inc da_thickness.inc da_tv_profile_adj.inc da_find_layer.inc da_thickness_adj.inc da_find_layer_tl.inc da_tv_profile.inc da_tpq_to_slp_adj.inc da_tpq_to_slp_lin.inc da_wrf_tpq_2_slp.inc da_tpq_to_slp.inc da_trh_to_td.inc da_tp_to_qs_lin1.inc da_tp_to_qs_lin.inc da_tp_to_qs_adj1.inc da_tp_to_qs_adj.inc da_tp_to_qs1.inc da_tp_to_qs.inc da_tprh_to_q_lin1.inc da_tprh_to_q_lin.inc da_tprh_to_q_adj1.inc da_tprh_to_q_adj.inc da_tpq_to_rh_lin1.inc da_tpq_to_rh_lin.inc da_tpq_to_rh.inc da_pt_to_rho_lin.inc da_pt_to_rho_adj.inc da_uvprho_to_w_adj.inc da_uvprho_to_w_lin.inc da_prho_to_t_lin.inc da_prho_to_t_adj.inc da_trop_wmo.inc da_wrf_interfaces.o da_reporting.o da_dynamics.o da_interpolation.o da_tracing.o da_par_util.o da_define_structures.o da_control.o module_comm_dm.o module_dm.o module_domain.o da_grid_definitions.o da_gpseph.o da_pilot.o : da_pilot.f90 da_calculate_grady_pilot.inc da_get_innov_vector_pilot.inc da_check_max_iv_pilot.inc da_transform_xtoy_pilot_adj.inc da_transform_xtoy_pilot.inc da_print_stats_pilot.inc da_oi_stats_pilot.inc da_residual_pilot.inc da_jo_and_grady_pilot.inc da_ao_stats_pilot.inc da_tracing.o da_tools.o da_statistics.o da_physics.o da_grid_definitions.o da_par_util1.o da_par_util.o da_interpolation.o da_define_structures.o da_control.o module_domain.o da_polaramv.o : da_polaramv.f90 da_calculate_grady_polaramv.inc da_get_innov_vector_polaramv.inc da_check_max_iv_polaramv.inc da_transform_xtoy_polaramv_adj.inc da_transform_xtoy_polaramv.inc da_print_stats_polaramv.inc da_oi_stats_polaramv.inc da_residual_polaramv.inc da_jo_and_grady_polaramv.inc da_ao_stats_polaramv.inc da_tracing.o da_tools.o da_statistics.o da_physics.o da_grid_definitions.o da_par_util1.o da_par_util.o da_interpolation.o da_define_structures.o da_control.o module_domain.o da_profiler.o : da_profiler.f90 da_calculate_grady_profiler.inc da_get_innov_vector_profiler.inc da_check_max_iv_profiler.inc da_transform_xtoy_profiler_adj.inc da_transform_xtoy_profiler.inc da_print_stats_profiler.inc da_oi_stats_profiler.inc da_residual_profiler.inc da_jo_and_grady_profiler.inc da_ao_stats_profiler.inc da_tracing.o da_tools.o da_statistics.o da_physics.o da_grid_definitions.o da_par_util1.o da_par_util.o da_interpolation.o da_define_structures.o da_control.o module_domain.o da_pseudo.o : da_pseudo.f90 da_calculate_grady_pseudo.inc da_transform_xtoy_pseudo_adj.inc da_transform_xtoy_pseudo.inc da_print_stats_pseudo.inc da_oi_stats_pseudo.inc da_ao_stats_pseudo.inc da_get_innov_vector_pseudo.inc da_residual_pseudo.inc da_jo_and_grady_pseudo.inc da_tracing.o da_par_util1.o da_par_util.o da_tools.o da_statistics.o da_interpolation.o module_domain.o da_define_structures.o da_control.o da_qscat.o : da_qscat.f90 da_calculate_grady_qscat.inc da_transform_xtoy_qscat_adj.inc da_transform_xtoy_qscat.inc da_print_stats_qscat.inc da_oi_stats_qscat.inc da_ao_stats_qscat.inc da_get_innov_vector_qscat.inc da_check_max_iv_qscat.inc da_residual_qscat.inc da_jo_and_grady_qscat.inc da_tracing.o da_tools.o da_statistics.o da_physics.o da_grid_definitions.o da_par_util1.o da_par_util.o da_interpolation.o da_define_structures.o da_control.o module_domain.o -da_rad_diags.o : da_rad_diags.f90 +da_rad_diags.o : da_rad_diags.f90 da_radar.o : da_radar.f90 da_write_oa_radar_ascii.inc da_max_error_qc_radar.inc da_calculate_grady_radar.inc da_radial_velocity_adj.inc da_radial_velocity_lin.inc da_radial_velocity.inc da_radar_rf.inc da_get_innov_vector_radar.inc da_check_max_iv_radar.inc da_transform_xtoy_radar_adj.inc da_transform_xtoy_radar.inc da_print_stats_radar.inc da_oi_stats_radar.inc da_residual_radar.inc da_jo_and_grady_radar.inc da_ao_stats_radar.inc da_tools_serial.o da_reporting.o da_tracing.o da_tools.o da_statistics.o da_par_util1.o da_par_util.o da_interpolation.o da_define_structures.o da_control.o module_domain.o da_radzicevar_calc_ice_abc.inc da_radzicevar_pkx.inc da_radzicevar_rain_adj.inc da_radzicevar_virtual.inc da_radzicevar_cal_tl_fw4wetice.inc da_radzicevar_parameter_zrx.inc da_radzicevar_prepare_interceptpara.inc da_radzicevar_rain_tl.inc da_radzicevar_waterfraction.inc da_radzicevar_dryice_adj.inc da_radzicevar_parameter_zxx.inc da_radzicevar_prepare_mixingratios.inc da_radzicevar_rhoair_tl.inc da_radzicevar_wetice_adj.inc da_radzicevar_dryice_tl.inc da_radzicevar_prepare_zmm_adj.inc da_radzicevar_sigma_in_abc.inc da_radzicevar_wetice_tl.inc da_radzicevar_pxabk.inc da_radzicevar_upper_f.inc da_radzicevar.inc da_radzicevar_tl.inc da_radzicevar_adj.inc +da_radiance.o : da_radiance.f90 da_blacklist_rad.inc da_read_pseudo_rad.inc da_get_innov_vector_radiance.inc da_radiance_init.inc da_setup_radiance_structures.inc da_sort_rad.inc da_read_kma1dvar.inc da_initialize_rad_iv.inc da_allocate_rad_iv.inc da_read_obs_bufrssmis.inc da_read_obs_bufrairs.inc da_read_obs_bufriasi.inc da_read_obs_bufrseviri.inc da_read_obs_bufrtovs.inc da_write_filtered_rad.inc da_read_simulated_rad.inc da_read_filtered_rad.inc da_calculate_grady_rad.inc gsi_thinning.o da_wrf_interfaces.o da_varbc.o da_tracing.o da_tools.o da_statistics.o da_rttov.o da_reporting.o da_radiance1.o da_physics.o da_par_util.o da_par_util1.o da_tools_serial.o da_interpolation.o da_define_structures.o da_crtm.o da_control.o module_radiance.o module_domain.o module_dm.o amsr2time_.c da_read_obs_hdf5amsr2.inc da_deallocate_radiance.inc da_read_obs_ncgoesimg.inc da_get_sat_angles.inc da_get_sat_angles_1d.inc da_get_solar_angles.inc da_get_solar_angles_1d.inc da_get_satzen.inc da_read_obs_hdf5ahi.inc da_read_obs_netcdf4ahi_jaxa.inc da_read_obs_hdf5gmi.inc da_read_obs_netcdf4ahi_geocat.inc mod_clddet_geoir.o da_read_obs_ncgoesabi.inc +da_radiance1.o : da_radiance1.f90 da_mspps_ts.inc da_mspps_emis.inc da_setup_satcv.inc da_qc_rad.inc da_print_stats_rad.inc da_oi_stats_rad.inc da_ao_stats_rad.inc da_cld_eff_radius.inc da_detsurtyp.inc da_write_oa_rad_ascii.inc da_write_iv_rad_ascii.inc da_qc_mhs.inc da_qc_ssmis.inc da_qc_hirs.inc da_qc_amsub.inc da_qc_amsua.inc da_qc_airs.inc da_cloud_detect.inc da_cloud_sim.inc da_qc_seviri.inc da_qc_iasi.inc da_qc_crtm.inc da_predictor_crtm.inc da_predictor_rttov.inc da_write_biasprep.inc da_biasprep.inc da_read_biascoef.inc da_biascorr.inc da_residual_rad.inc da_jo_and_grady_rad.inc gsi_constants.o da_tracing.o da_tools_serial.o da_tools.o da_statistics.o da_reporting.o da_par_util1.o da_par_util.o module_dm.o da_define_structures.o da_control.o module_radiance.o da_wrf_interfaces.o da_qc_amsr2.inc da_qc_goesimg.inc da_qc_ahi.inc da_qc_gmi.inc da_qc_goesabi.inc da_lightning.o : da_lightning.f90 da_calculate_grady_lightning.inc da_get_innov_vector_lightning.inc da_check_max_iv_lightning.inc da_transform_xtoy_lightning_adj.inc da_transform_xtoy_lightning.inc da_print_stats_lightning.inc da_oi_stats_lightning.inc da_residual_lightning.inc da_jo_and_grady_lightning.inc da_ao_stats_lightning.inc da_div_profile.inc da_div_profile_adj.inc da_div_profile_tl.inc da_tracing.o da_tools.o da_statistics.o da_physics.o da_par_util1.o da_par_util.o da_define_structures.o da_control.o module_domain.o -da_radiance.o : da_radiance.f90 da_blacklist_rad.inc da_read_pseudo_rad.inc da_get_innov_vector_radiance.inc da_radiance_init.inc da_setup_radiance_structures.inc da_sort_rad.inc da_read_kma1dvar.inc da_initialize_rad_iv.inc da_allocate_rad_iv.inc da_read_obs_bufrssmis.inc da_read_obs_bufrairs.inc da_read_obs_bufriasi.inc da_read_obs_bufrseviri.inc da_read_obs_bufrtovs.inc da_write_filtered_rad.inc da_read_simulated_rad.inc da_read_filtered_rad.inc da_calculate_grady_rad.inc gsi_thinning.o da_wrf_interfaces.o da_varbc.o da_tracing.o da_tools.o da_statistics.o da_rttov.o da_reporting.o da_radiance1.o da_physics.o da_par_util.o da_par_util1.o da_tools_serial.o da_interpolation.o da_define_structures.o da_crtm.o da_control.o module_radiance.o module_domain.o amsr2time_.c da_read_obs_hdf5amsr2.inc da_deallocate_radiance.inc da_read_obs_ncgoesimg.inc da_get_satzen.inc da_read_obs_hdf5ahi.inc da_read_obs_netcdf4ahi_jaxa.inc da_read_obs_hdf5gmi.inc da_read_obs_netcdf4ahi_geocat.inc mod_clddet_geoir.o -da_radiance1.o : da_radiance1.f90 da_mspps_ts.inc da_mspps_emis.inc da_setup_satcv.inc da_qc_rad.inc da_print_stats_rad.inc da_oi_stats_rad.inc da_ao_stats_rad.inc da_cld_eff_radius.inc da_detsurtyp.inc da_write_oa_rad_ascii.inc da_write_iv_rad_ascii.inc da_qc_mhs.inc da_qc_ssmis.inc da_qc_hirs.inc da_qc_amsub.inc da_qc_amsua.inc da_qc_airs.inc da_cloud_detect.inc da_cloud_sim.inc da_qc_seviri.inc da_qc_iasi.inc da_qc_crtm.inc da_predictor_crtm.inc da_predictor_rttov.inc da_write_biasprep.inc da_biasprep.inc da_read_biascoef.inc da_biascorr.inc da_residual_rad.inc da_jo_and_grady_rad.inc gsi_constants.o da_tracing.o da_tools_serial.o da_tools.o da_statistics.o da_reporting.o da_par_util1.o da_par_util.o module_dm.o da_define_structures.o da_control.o module_radiance.o da_wrf_interfaces.o da_qc_amsr2.inc da_qc_goesimg.inc da_qc_ahi.inc da_qc_gmi.inc da_rain.o : da_rain.f90 da_calculate_grady_rain.inc da_get_innov_vector_rain.inc da_get_hr_rain.inc da_check_max_iv_rain.inc da_transform_xtoy_rain_adj.inc da_transform_xtoy_rain.inc da_print_stats_rain.inc da_oi_stats_rain.inc da_residual_rain.inc da_jo_and_grady_rain.inc da_ao_stats_rain.inc da_tracing.o da_tools.o da_statistics.o da_par_util.o da_par_util1.o da_interpolation.o da_define_structures.o da_control.o module_comm_dm.o module_dm.o module_domain.o da_recursive_filter.o : da_recursive_filter.f90 da_apply_rf_adj.inc da_apply_rf.inc da_apply_rf_1v_adj.inc da_apply_rf_1v.inc da_transform_through_rf_adj.inc da_transform_through_rf.inc da_transform_through_rf_inv.inc da_recursive_filter_1d_adj.inc da_recursive_filter_1d.inc da_recursive_filter_1d_inv.inc da_calculate_rf_factors.inc da_transform_through_rf_dual_res.inc da_transform_through_rf_adj_dual_res.inc da_perform_2drf.inc da_rf_cv3.o da_rfz_cv3.o da_tracing.o da_par_util.o da_define_structures.o da_control.o module_domain.o da_reporting.o : da_reporting.f90 da_message2.inc da_message.inc da_warning.inc da_error.inc da_control.o da_rf_cv3.o : da_rf_cv3.f90 da_mat_cv3.o da_rfz_cv3.o : da_rfz_cv3.f90 da_rsl_interfaces.o : da_rsl_interfaces.f90 -da_rttov.o : da_rttov.f90 da_rttov_ad.inc da_rttov_tl.inc da_rttov_direct.inc da_rttov_init.inc da_transform_xtoy_rttov_adj.inc da_transform_xtoy_rttov.inc da_get_innov_vector_rttov.inc da_rttov_k.inc da_wrf_interfaces.o da_tracing.o da_tools.o da_radiance1.o da_par_util.o da_tools_serial.o da_interpolation.o da_control.o module_radiance.o da_reporting.o module_domain.o da_define_structures.o +da_rttov.o : da_rttov.f90 da_rttov_ad.inc da_rttov_tl.inc da_rttov_direct.inc da_rttov_init.inc da_transform_xtoy_rttov_adj.inc da_transform_xtoy_rttov.inc da_get_innov_vector_rttov.inc da_rttov_k.inc da_wrf_interfaces.o da_tracing.o da_tools.o da_radiance1.o da_par_util.o da_tools_serial.o da_interpolation.o da_control.o module_radiance.o da_reporting.o module_domain.o da_define_structures.o da_physics.o da_satem.o : da_satem.f90 da_calculate_grady_satem.inc da_get_innov_vector_satem.inc da_check_max_iv_satem.inc da_transform_xtoy_satem_adj.inc da_transform_xtoy_satem.inc da_print_stats_satem.inc da_oi_stats_satem.inc da_residual_satem.inc da_jo_and_grady_satem.inc da_ao_stats_satem.inc da_tracing.o da_tools.o da_statistics.o da_physics.o da_par_util1.o da_par_util.o da_define_structures.o da_control.o module_domain.o da_setup_structures.o : da_setup_structures.f90 da_truncate_spectra.inc da_get_bins_info.inc da_write_kma_increments.inc da_write_increments_for_wrf_nmm_regional.inc da_write_increments.inc da_qfrmrh.inc da_cumulus.inc da_lcl.inc da_cloud_model.inc da_setup_runconstants.inc da_setup_obs_interp_wts.inc da_setup_obs_structures_madis.inc da_setup_obs_structures_bufr.inc da_setup_obs_structures_ascii.inc da_setup_obs_structures_rain.inc da_setup_obs_structures_radar.inc da_setup_obs_structures_lightning.inc da_setup_obs_structures.inc da_setup_flow_predictors.inc da_setup_flow_predictors_para_read_opt1.inc da_chgvres.inc da_setup_cv.inc da_setup_be_nmm_regional.inc da_setup_be_regional.inc da_setup_be_ncep_gfs.inc da_setup_be_global.inc da_setup_background_errors.inc da_scale_background_errors.inc da_scale_background_errors_cv3.inc da_rescale_background_errors.inc da_interpolate_regcoeff.inc da_get_vertical_truncation.inc gsi_thinning.o module_radiance.o da_rf_cv3.o da_rfz_cv3.o da_vtox_transforms.o da_tracing.o da_tools.o da_tools_serial.o da_ssmi.o da_spectral.o da_recursive_filter.o da_reporting.o da_radiance.o da_par_util.o da_par_util1.o da_obs_io.o da_obs.o da_control.o da_wrf_interfaces.o da_define_structures.o module_domain.o da_wavelet.o da_chg_be_Vres.inc da_gen_eigen.inc da_eigen_to_covmatrix.inc da_setup_pseudo_obs.inc da_setup_flow_predictors_ep_format2.inc da_setup_flow_predictors_ep_format3.inc da_get_alpha_vertloc.inc da_write_vp.inc module_state_description.o da_setup_obs_structures_chem_sfc.inc da_ships.o : da_ships.f90 da_calculate_grady_ships.inc da_get_innov_vector_ships.inc da_check_max_iv_ships.inc da_transform_xtoy_ships_adj.inc da_transform_xtoy_ships.inc da_print_stats_ships.inc da_oi_stats_ships.inc da_residual_ships.inc da_jo_and_grady_ships.inc da_ao_stats_ships.inc da_tracing.o da_tools.o da_statistics.o da_physics.o da_grid_definitions.o da_par_util1.o da_par_util.o da_interpolation.o da_define_structures.o da_control.o module_domain.o @@ -165,7 +165,7 @@ da_synop.o : da_synop.f90 da_check_buddy_synop.inc da_calculate_grady_synop.inc da_tamdar.o : da_tamdar.f90 da_calculate_grady_tamdar_sfc.inc da_check_max_iv_tamdar_sfc.inc da_get_innov_vector_tamdar_sfc.inc da_transform_xtoy_tamdar_sfc_adj.inc da_transform_xtoy_tamdar_sfc.inc da_print_stats_tamdar_sfc.inc da_oi_stats_tamdar_sfc.inc da_residual_tamdar_sfc.inc da_jo_tamdar_sfc_uvtq.inc da_jo_and_grady_tamdar_sfc.inc da_ao_stats_tamdar_sfc.inc da_calculate_grady_tamdar.inc da_get_innov_vector_tamdar.inc da_check_max_iv_tamdar.inc da_transform_xtoy_tamdar_adj.inc da_transform_xtoy_tamdar.inc da_print_stats_tamdar.inc da_oi_stats_tamdar.inc da_residual_tamdar.inc da_jo_tamdar_uvtq.inc da_jo_and_grady_tamdar.inc da_ao_stats_tamdar.inc da_tracing.o da_physics.o da_grid_definitions.o da_par_util1.o da_par_util.o da_tools.o da_statistics.o da_interpolation.o module_domain.o da_define_structures.o da_control.o da_varbc_tamdar.o da_varbc_tamdar.o : da_varbc_tamdar.f90 da_varbc_tamdar_init.inc da_varbc_tamdar_pred.inc da_varbc_tamdar_precond.inc da_varbc_tamdar_direct.inc da_varbc_tamdar_adj.inc da_varbc_tamdar_tl.inc da_varbc_tamdar_update.inc da_tracing.o da_tools_serial.o da_tools.o da_reporting.o da_define_structures.o da_control.o module_dm.o da_test.o : da_test.f90 da_test_vxtransform.inc da_check_gradient.inc da_get_y_lhs_value.inc da_check_vtoy_adjoint.inc da_set_tst_trnsf_fld.inc da_check_psfc.inc da_check_sfc_assi.inc da_setup_testfield.inc da_check_xtoy_adjoint_buoy.inc da_check_xtoy_adjoint_profiler.inc da_check_xtoy_adjoint_ssmt2.inc da_check_xtoy_adjoint_ssmt1.inc da_check_xtoy_adjoint_qscat.inc da_check_xtoy_adjoint_pseudo.inc da_dot_cv.inc da_dot.inc da_check.inc da_check_gradient.inc da_transform_xtovp.inc da_check_xtoy_adjoint_rad.inc da_check_xtoy_adjoint_synop.inc da_check_xtoy_adjoint_tamdar_sfc.inc da_check_xtoy_adjoint_tamdar.inc da_check_xtoy_adjoint_mtgirs.inc da_check_xtoy_adjoint_sonde_sfc.inc da_check_xtoy_adjoint_sound.inc da_check_xtoy_adjoint_bogus.inc da_check_xtoy_adjoint_rain.inc da_check_xtoy_adjoint_radar.inc da_check_xtoy_adjoint_lightning.inc da_check_xtoy_adjoint_ships.inc da_check_xtoy_adjoint_polaramv.inc da_check_xtoy_adjoint_geoamv.inc da_check_xtoy_adjoint_satem.inc da_check_xtoy_adjoint_ssmi_tb.inc da_check_xtoy_adjoint_ssmi_rv.inc da_check_xtoy_adjoint_pilot.inc da_check_xtoy_adjoint_metar.inc da_check_xtoy_adjoint_gpsref.inc da_check_xtoy_adjoint_gpspw.inc da_check_xtoy_adjoint_airep.inc da_check_xtoy_adjoint.inc da_check_xtovptox_errors.inc da_check_vvtovp_adjoint.inc da_check_vp_errors.inc da_check_vptox_adjoint.inc da_check_vtox_adjoint.inc da_check_cvtovv_adjoint.inc da_check_balance.inc da_4dvar.o da_vtox_transforms.o da_wrfvar_io.o da_wrf_interfaces.o da_transfer_model.o da_tracing.o da_tools_serial.o da_statistics.o da_ssmi.o da_spectral.o da_reporting.o da_physics.o da_par_util1.o da_par_util.o da_obs.o da_minimisation.o da_ffts.o da_dynamics.o da_define_structures.o module_state_description.o module_domain.o da_control.o module_comm_dm.o module_dm.o module_configure.o da_rain.o da_check_dynamics_adjoint.inc da_check_xtoy_adjoint_gpseph.inc da_check_cvtovv_adjoint_chem.inc da_check_vtox_adjoint_chem.inc da_check_vchemtox_adjoint.inc -da_tools.o : da_tools.f90 da_geo2msl1.inc da_msl2geo1.inc da_get_time_slots.inc da_get_julian_time.inc da_get_print_lvl.inc da_get_3d_sum.inc da_get_2d_sum.inc da_set_boundary_3d.inc da_set_boundary_xb.inc da_set_boundary_xa.inc da_ludcmp.inc da_lubksb.inc da_eof_decomposition.inc da_eof_decomposition_test.inc da_buddy_qc.inc da_unifva.inc da_togrid.inc da_togrid_new.inc da_smooth_anl.inc da_openfile.inc da_gaus_noise.inc da_set_randomcv.inc da_random_omb.inc da_max_error_qc.inc da_add_noise_new.inc da_add_noise.inc da_residual_new.inc da_residual.inc da_diff_seconds.inc da_mo_correction.inc da_intpsfc_tem.inc da_intpsfc_prs.inc da_sfcprs.inc da_obs_sfc_correction.inc da_1d_eigendecomposition.inc da_convert_zk.inc da_lc_cone.inc da_set_merc.inc da_map_set.inc da_map_init.inc da_set_ps.inc da_set_lc.inc da_xyll_ps.inc da_xyll_merc.inc da_xyll_lc.inc da_xyll_latlon.inc da_xyll_default.inc da_xyll.inc da_llxy_wrf_new.inc da_llxy_wrf.inc da_llxy_ps_new.inc da_llxy_ps.inc da_llxy_merc_new.inc da_llxy_merc.inc da_llxy_lc_new.inc da_llxy_lc.inc da_llxy_latlon_new.inc da_llxy_latlon.inc da_llxy_rotated_latlon.inc da_llxy_global_new.inc da_llxy_global.inc da_llxy_kma_global_new.inc da_llxy_kma_global.inc da_llxy_default_new.inc da_llxy_default.inc da_llxy_new.inc da_llxy.inc da_map_utils_defines.inc da_lapack.o da_reporting.o da_tracing.o da_tools_serial.o da_define_structures.o da_control.o module_domain.o module_dm.o module_bc.o da_sfc_hori_interp_weights.inc +da_tools.o : da_tools.f90 da_geo2msl1.inc da_msl2geo1.inc da_get_time_slots.inc da_get_julian_time.inc da_get_print_lvl.inc da_get_3d_sum.inc da_get_2d_sum.inc da_set_boundary_3d.inc da_set_boundary_xb.inc da_set_boundary_xa.inc da_ludcmp.inc da_lubksb.inc da_eof_decomposition.inc da_eof_decomposition_test.inc da_buddy_qc.inc da_unifva.inc da_togrid.inc da_togrid_new.inc da_smooth_anl.inc da_openfile.inc da_gaus_noise.inc da_set_randomcv.inc da_random_omb.inc da_max_error_qc.inc da_add_noise_new.inc da_add_noise.inc da_residual_new.inc da_residual.inc da_diff_seconds.inc da_mo_correction.inc da_intpsfc_tem.inc da_intpsfc_prs.inc da_sfcprs.inc da_obs_sfc_correction.inc da_1d_eigendecomposition.inc da_convert_zk.inc da_lc_cone.inc da_set_merc.inc da_map_set.inc da_map_init.inc da_set_ps.inc da_set_lc.inc da_xyll_ps.inc da_xyll_merc.inc da_xyll_lc.inc da_xyll_latlon.inc da_xyll_default.inc da_xyll.inc da_llxy_wrf_new.inc da_llxy_wrf.inc da_llxy_ps_new.inc da_llxy_ps.inc da_llxy_merc_new.inc da_llxy_merc.inc da_llxy_lc_new.inc da_llxy_lc.inc da_llxy_latlon_new.inc da_llxy_latlon.inc da_llxy_rotated_latlon.inc da_llxy_global_new.inc da_llxy_global.inc da_llxy_kma_global_new.inc da_llxy_kma_global.inc da_llxy_default_new.inc da_llxy_default.inc da_llxy_new.inc da_llxy.inc da_llxy_1d.inc da_llxy_default_1d.inc da_llxy_global_1d.inc da_llxy_kma_global_1d.inc da_llxy_latlon_1d.inc da_llxy_lc_1d.inc da_llxy_merc_1d.inc da_llxy_ps_1d.inc da_llxy_rotated_latlon_1d.inc da_llxy_wrf_1d.inc da_togrid_1d.inc da_map_utils_defines.inc da_lapack.o da_reporting.o da_tracing.o da_tools_serial.o da_define_structures.o da_control.o module_domain.o module_dm.o module_bc.o da_sfc_hori_interp_weights.inc da_tools_serial.o : da_tools_serial.f90 da_find_fft_trig_funcs.inc da_find_fft_factors.inc da_advance_time.inc da_advance_cymdh.inc da_array_print.inc da_change_date.inc da_free_unit.inc da_get_unit.inc da_reporting.o da_control.o da_tracing.o : da_tracing.f90 da_trace_report.inc da_trace_real_sort.inc da_trace_int_sort.inc da_trace_exit.inc da_trace.inc da_trace_entry.inc da_trace_init.inc da_reporting.o da_par_util1.o da_control.o da_transfer_model.o : da_transfer_model.f90 da_get_2nd_firstguess.inc da_setup_firstguess_kma.inc da_setup_firstguess_wrf_nmm_regional.inc da_setup_firstguess_wrf.inc da_setup_firstguess.inc da_transfer_xatoanalysis.inc da_transfer_wrftl_lbc_t0_adj.inc da_transfer_xatowrftl_adj_lbc.inc da_transfer_xatowrftl_adj.inc da_transfer_wrftl_lbc_t0.inc da_transfer_xatowrftl_lbc.inc da_transfer_xatowrftl.inc da_transfer_wrftltoxa_adj.inc da_transfer_wrftltoxa.inc da_transfer_xatokma.inc da_transfer_xatowrf_nmm_regional.inc da_transfer_xatowrf.inc da_transfer_kmatoxb.inc da_transfer_wrf_nmm_regional_toxb.inc da_transfer_wrftoxb.inc module_io_wrf.o module_bc.o da_4dvar.o da_vtox_transforms.o da_tracing.o da_tools.o da_ssmi.o da_setup_structures.o da_reporting.o da_physics.o da_par_util.o da_grid_definitions.o da_define_structures.o da_control.o module_comm_dm.o module_dm.o module_state_description.o module_io_domain.o module_domain.o module_date_time.o module_configure.o da_wrf_interfaces.o da_radar.o da_lightning.o da_transfer_wrftoxb_chem.inc diff --git a/var/da/da_define_structures/da_define_structures.f90 b/var/da/da_define_structures/da_define_structures.f90 index 095c5dbcb7..2ecff3eaaa 100644 --- a/var/da/da_define_structures/da_define_structures.f90 +++ b/var/da/da_define_structures/da_define_structures.f90 @@ -574,10 +574,12 @@ module da_define_structures real, pointer :: vtox(:,:) end type varbc_type type clddet_geoir_type - real :: RTCT, RFMFT, TEMPIR, terr_hgt - real :: tb_stddev_10, tb_stddev_13,tb_stddev_14 - real :: CIRH2O - !real, allocatable :: CIRH2O(:,:,:) + real :: RTCT, RFMFT, TEMPIR, terr_hgt ! for both ABI and AHI + real :: tb_stddev_10, tb_stddev_13,tb_stddev_14 ! only for AHI + real :: CIRH2O ! for both ABI and AHI + real, allocatable :: CIRH2O_abi(:,:,:) ! only for ABI + real, allocatable :: tb_stddev_3x3(:) ! only for ABI + integer :: RFMFT_ij(2) ! only for ABI end type clddet_geoir_type type superob_type real, allocatable :: tb_obs(:,:) @@ -618,6 +620,8 @@ module da_define_structures integer, pointer :: cloud_flag(:,:) integer, pointer :: cloudflag(:) integer, pointer :: rain_flag(:) + real, pointer :: cloud_mod(:,:) ! only for ABI + real, pointer :: cloud_obs(:,:) ! only for ABI real, allocatable :: cloud_frac(:) real, pointer :: satzen(:) real, pointer :: satazi(:) @@ -632,10 +636,10 @@ module da_define_structures real, pointer :: lod(:,:,:) ! layer_optical_depth real, pointer :: trans(:,:,:) ! layer transmittance real, pointer :: der_trans(:,:,:) ! d(transmittance)/dp - real, pointer :: kmin_t(:) - real, pointer :: kmax_p(:) - real, pointer :: sensitivity_ratio(:,:,:) - real, pointer :: p_chan_level(:,:) + real, pointer :: kmin_t(:) + real, pointer :: kmax_p(:) + real, pointer :: sensitivity_ratio(:,:,:) + real, pointer :: p_chan_level(:,:) real, pointer :: qrn(:,:) real, pointer :: qcw(:,:) real, pointer :: qci(:,:) diff --git a/var/da/da_monitor/da_rad_diags.f90 b/var/da/da_monitor/da_rad_diags.f90 index af42a488ff..6d2db8f686 100644 --- a/var/da/da_monitor/da_rad_diags.f90 +++ b/var/da/da_monitor/da_rad_diags.f90 @@ -42,7 +42,7 @@ program da_rad_diags integer :: ncid, dimid, varid integer, dimension(3) :: ishape, istart, icount ! - logical :: amsr2 + logical :: amsr2, abi logical :: isfile, prf_found, jac_found integer, parameter :: datelen1 = 10 integer, parameter :: datelen2 = 19 @@ -62,9 +62,9 @@ program da_rad_diags real*4, dimension(:), allocatable :: smois, tslb, snowh, vegfra, clwp, cloud_frac real*4, dimension(:), allocatable :: cip ! cloud-ice path integer, dimension(:), allocatable :: cloudflag ! cloudflag from L2 AHI - integer, dimension(:,:), allocatable :: tb_qc + integer, dimension(:,:), allocatable :: tb_qc, cloud_flag real*4, dimension(:,:), allocatable :: tb_obs, tb_bak, tb_inv, tb_oma, tb_err, ems, ems_jac - real*4, dimension(:,:), allocatable :: tb_bak_clr ! clear-sky brightness temp + real*4, dimension(:,:), allocatable :: cloud_mod, cloud_obs, tb_bak_clr ! clear-sky brightness temp real*4, dimension(:,:), allocatable :: weightfunc_peak ! peak of weighting function real*4, dimension(:,:), allocatable :: prf_pfull, prf_phalf, prf_t, prf_q, prf_water real*4, dimension(:,:), allocatable :: prf_ice, prf_rain, prf_snow, prf_grau, prf_hail @@ -139,6 +139,7 @@ program da_rad_diags write(0,*) trim(instid(iinst)) amsr2 = index(instid(iinst),'amsr2') > 0 + abi = index(instid(iinst),'abi') > 0 nerr = 0 total_npixel = 0 @@ -263,6 +264,12 @@ program da_rad_diags allocate ( tb_oma(1:nchan,1:total_npixel) ) allocate ( tb_err(1:nchan,1:total_npixel) ) allocate ( tb_qc(1:nchan,1:total_npixel) ) + if ( abi ) then + allocate ( cloud_mod(1:nchan,1:total_npixel) ) + allocate ( cloud_obs(1:nchan,1:total_npixel) ) + allocate ( cloud_flag(1:nchan,1:total_npixel)) + cloud_flag = 0 + end if allocate ( ems(1:nchan,1:total_npixel) ) if ( jac_found ) then allocate ( ems_jac(1:nchan,1:total_npixel) ) @@ -333,6 +340,11 @@ program da_rad_diags tb_inv = missing_r tb_oma = missing_r tb_err = missing_r + if ( abi ) then + cloud_mod = missing_r + cloud_obs = missing_r + end if + ncname = 'diags_'//trim(instid(iinst))//"_"//datestr1(itime)//'.nc' ios = NF_CREATE(trim(ncname), NF_NETCDF4, ncid) ! Change to output netcdf4 files !ios = NF_CREATE(trim(ncname), NF_CLOBBER, ncid) ! NF_CLOBBER specifies the default behavior of @@ -392,7 +404,15 @@ program da_rad_diags read(unit=iunit(iproc),fmt='(10f11.2)',iostat=ios) tb_err(:,ipixel) read(unit=iunit(iproc),fmt='(a)',iostat=ios) buf ! QC read(unit=iunit(iproc),fmt='(10i11)',iostat=ios ) tb_qc(:,ipixel) - read(unit=iunit(iproc),fmt='(a)',iostat=ios) buf + read(unit=iunit(iproc),fmt='(a)',iostat=ios) buf + if ( abi .and. buf(1:4) == "CMOD" ) then ! read cloud_mod, cloud_obs, cloud_flag for abi + read(unit=iunit(iproc),fmt='(10f11.2)',iostat=ios) cloud_mod(:,ipixel) + read(unit=iunit(iproc),fmt='(a)',iostat=ios) buf ! CMOD + read(unit=iunit(iproc),fmt='(10f11.2)',iostat=ios) cloud_obs(:,ipixel) + read(unit=iunit(iproc),fmt='(a)',iostat=ios) buf ! COBS + read(unit=iunit(iproc),fmt='(10i11)',iostat=ios ) cloud_flag(:,ipixel) + read(unit=iunit(iproc),fmt='(a)',iostat=ios) buf ! cloud_flag + end if if ( buf(1:4) == "INFO" ) then backspace(iunit(iproc)) cycle npixel_loop @@ -523,6 +543,13 @@ program da_rad_diags end if ios = NF_DEF_VAR(ncid, 'tb_err', NF_FLOAT, 2, ishape(1:2), varid) ios = NF_DEF_VAR(ncid, 'tb_qc', NF_INT, 2, ishape(1:2), varid) + if ( abi ) then + ios = NF_DEF_VAR(ncid, 'cloud_mod', NF_FLOAT, 2, ishape(1:2), varid) + ios = NF_PUT_ATT_REAL(ncid, varid, 'missing_value', NF_FLOAT, 1, missing_r) + ios = NF_DEF_VAR(ncid, 'cloud_obs', NF_FLOAT, 2, ishape(1:2), varid) + ios = NF_PUT_ATT_REAL(ncid, varid, 'missing_value', NF_FLOAT, 1, missing_r) + ios = NF_DEF_VAR(ncid, 'cloud_flag', NF_INT, 2, ishape(1:2), varid) + end if ! ! define 2-D array with dimensions nlev * total_npixel ! @@ -669,6 +696,14 @@ program da_rad_diags ios = NF_PUT_VARA_REAL(ncid, varid, istart(1:2), icount(1:2), tb_err) ios = NF_INQ_VARID (ncid, 'tb_qc', varid) ios = NF_PUT_VARA_INT(ncid, varid, istart(1:2), icount(1:2), tb_qc) + if ( abi ) then + ios = NF_INQ_VARID (ncid, 'cloud_mod', varid) + ios = NF_PUT_VARA_REAL(ncid, varid, istart(1:2), icount(1:2), cloud_mod) + ios = NF_INQ_VARID (ncid, 'cloud_obs', varid) + ios = NF_PUT_VARA_REAL(ncid, varid, istart(1:2), icount(1:2), cloud_obs) + ios = NF_INQ_VARID (ncid, 'cloud_flag', varid) + ios = NF_PUT_VARA_INT(ncid, varid, istart(1:2), icount(1:2), cloud_flag) + end if ! ! output 2-D array with dimensions nlev * total_npixel ! @@ -890,6 +925,11 @@ program da_rad_diags deallocate ( tb_bak_clr ) deallocate ( weightfunc_peak ) deallocate ( tb_inv ) + if ( abi ) then + deallocate ( cloud_mod ) + deallocate ( cloud_obs ) + deallocate ( cloud_flag ) + end if deallocate ( tb_oma ) deallocate ( ems ) if ( jac_found ) deallocate ( ems_jac ) diff --git a/var/da/da_radiance/da_allocate_rad_iv.inc b/var/da/da_radiance/da_allocate_rad_iv.inc index d5b5eb61ad..947498601b 100644 --- a/var/da/da_radiance/da_allocate_rad_iv.inc +++ b/var/da/da_radiance/da_allocate_rad_iv.inc @@ -80,6 +80,10 @@ subroutine da_allocate_rad_iv (i, nchan, iv) end if if ( index(iv%instid(i)%rttovid_string, 'ahi') > 0 ) then allocate (iv%instid(i)%cloudflag(iv%instid(i)%num_rad)) + end if + if ( index(iv%instid(i)%rttovid_string, 'abi') > 0 ) then + allocate (iv%instid(i)%cloud_mod(nchan,iv%instid(i)%num_rad)) + allocate (iv%instid(i)%cloud_obs(nchan,iv%instid(i)%num_rad)) end if if ( index(iv%instid(i)%rttovid_string, 'gmi') > 0 ) then allocate (iv%instid(i)%clw(iv%instid(i)%num_rad)) @@ -112,16 +116,26 @@ subroutine da_allocate_rad_iv (i, nchan, iv) allocate (iv%instid(i)%gamma_jacobian(nchan,iv%instid(i)%num_rad)) allocate (iv%instid(i)%cloud_frac(iv%instid(i)%num_rad)) if ( use_clddet_zz ) then - iv%instid(i)%superob_width = 2*ahi_superob_halfwidth+1 + ! here we assume AHI and ABI (they cover different regions) are not used simultaneously + if ( index(iv%instid(i)%rttovid_string, 'ahi') > 0 ) & + iv%instid(i)%superob_width = 2*ahi_superob_halfwidth+1 + if ( index(iv%instid(i)%rttovid_string, 'abi') > 0 ) & + iv%instid(i)%superob_width = 2*abi_superob_halfwidth+1 + allocate (iv%instid(i)%superob(iv%instid(i)%superob_width, & iv%instid(i)%superob_width)) do iy = 1, iv%instid(i)%superob_width do ix = 1, iv%instid(i)%superob_width allocate (iv%instid(i)%superob(ix,iy)%cld_qc(iv%instid(i)%num_rad)) allocate (iv%instid(i)%superob(ix,iy)%tb_obs(nchan,iv%instid(i)%num_rad)) + if ( index(iv%instid(i)%rttovid_string, 'abi') > 0 ) then + do n = 1, iv%instid(i)%num_rad + allocate (iv%instid(i)%superob(ix,iy)%cld_qc(n)%tb_stddev_3x3(nchan)) + end do + end if end do end do - end if + end if if ( use_rttov_kmatrix .or. use_crtm_kmatrix ) then allocate(iv%instid(i)%ts_jacobian(nchan,iv%instid(i)%num_rad)) allocate(iv%instid(i)%ps_jacobian(nchan,iv%instid(i)%num_rad)) diff --git a/var/da/da_radiance/da_deallocate_radiance.inc b/var/da/da_radiance/da_deallocate_radiance.inc index e0e9f71b55..1ba3834654 100644 --- a/var/da/da_radiance/da_deallocate_radiance.inc +++ b/var/da/da_radiance/da_deallocate_radiance.inc @@ -38,6 +38,13 @@ deallocate ( satinfo(i) % clearSkyBias) endif + ! Deallocate extra variables for ABI + if ( index(iv%instid(i)%rttovid_string, 'abi') > 0 ) then + deallocate (satinfo(i) % error_cld_y) + deallocate (satinfo(i) % error_cld_x) + endif + + if (use_error_factor_rad) then deallocate (satinfo(i) % error_factor) endif @@ -115,6 +122,10 @@ end if if ( index(iv%instid(i)%rttovid_string, 'ahi') > 0 ) then deallocate (iv%instid(i)%cloudflag) + end if + if ( index(iv%instid(i)%rttovid_string, 'abi') > 0 ) then + deallocate (iv%instid(i)%cloud_mod) + deallocate (iv%instid(i)%cloud_obs) end if if ( index(iv%instid(i)%rttovid_string,'gmi') > 0 ) then deallocate (iv%instid(i)%clw) @@ -149,8 +160,16 @@ if ( use_clddet_zz ) then do iy = 1, iv%instid(i)%superob_width do ix = 1, iv%instid(i)%superob_width - deallocate (iv%instid(i)%superob(ix,iy)%cld_qc) - deallocate (iv%instid(i)%superob(ix,iy)%tb_obs) + if ( index(iv%instid(i)%rttovid_string, 'abi') > 0 ) then + do n = 1,iv%instid(i)%num_rad + if ( allocated (iv%instid(i)%superob(ix,iy)%cld_qc(n)%tb_stddev_3x3) ) & + deallocate (iv%instid(i)%superob(ix,iy)%cld_qc(n)%tb_stddev_3x3) + if ( allocated (iv%instid(i)%superob(ix,iy)%cld_qc(n)%CIRH2O_abi) ) & + deallocate (iv%instid(i)%superob(ix,iy)%cld_qc(n)%CIRH2O_abi) + end do + end if + deallocate (iv%instid(i)%superob(ix,iy)%cld_qc) + deallocate (iv%instid(i)%superob(ix,iy)%tb_obs) end do end do deallocate (iv%instid(i)%superob) diff --git a/var/da/da_radiance/da_get_innov_vector_crtm.inc b/var/da/da_radiance/da_get_innov_vector_crtm.inc index d41260953d..17a8d4c635 100644 --- a/var/da/da_radiance/da_get_innov_vector_crtm.inc +++ b/var/da/da_radiance/da_get_innov_vector_crtm.inc @@ -92,7 +92,7 @@ subroutine da_get_innov_vector_crtm ( it, grid, ob, iv ) real, allocatable :: hessian(:,:) real*8, allocatable :: eignvec(:,:), eignval(:) real :: rad_clr, rad_ovc_ilev, rad_ovc_jlev - + integer :: Band_Size(5), Bands(AIRS_Max_Channels,5) !For Zhuge and Zou cloud detection real, allocatable :: geoht_full(:,:,:) @@ -243,9 +243,10 @@ subroutine da_get_innov_vector_crtm ( it, grid, ob, iv ) calc_tb_clr = .false. if ( crtm_cloud .and. & ( trim( crtm_sensor_name(rtminit_sensor(inst))) == 'amsr2' .or. & + trim( crtm_sensor_name(rtminit_sensor(inst))) == 'abi' .or. & trim( crtm_sensor_name(rtminit_sensor(inst))) == 'ahi') ) then !Tb_clear_sky is only needed for symmetric obs error model - !symmetric obs error model only implemented for amsr2 for now + !symmetric obs error model only implemented for amsr2 & abi/ahi for now calc_tb_clr = .true. end if @@ -443,7 +444,6 @@ subroutine da_get_innov_vector_crtm ( it, grid, ob, iv ) call da_trop_wmo ( tt_pixel, geoht_pixel, pp_pixel, (min(kte,kme-1)-kts+1), tropt = iv%instid(inst)%tropt(n) ) end if - call da_interp_2d_partial (grid%xb%u10, iv%instid(inst)%info, 1, n, n, model_u10(n:n)) call da_interp_2d_partial (grid%xb%v10, iv%instid(inst)%info, 1, n, n, model_v10(n:n)) call da_interp_2d_partial (grid%xb%psfc, iv%instid(inst)%info, 1, n, n, model_psfc(n:n)) @@ -476,6 +476,14 @@ subroutine da_get_innov_vector_crtm ( it, grid, ob, iv ) cycle pixel_loop end if end do + !if ( all(ob%instid(inst)%tb(1:nchanl,n) < 0.) ) then + ! write(message(1),'(a,2i5.0,a)') ' Skipping the pixel at loc ', i, j, & + ! ' where all observed BTs are < 0' + ! call da_warning(__FILE__,__LINE__,message(1:1)) + ! iv%instid(inst)%tb_inv(:,n) = missing_r + ! iv%instid(inst)%info%proc_domain(:,n) = .false. + ! cycle pixel_loop + !end if ! convert cloud content unit from kg/kg to kg/m^2 if (crtm_cloud) then diff --git a/var/da/da_radiance/da_get_innov_vector_rttov.inc b/var/da/da_radiance/da_get_innov_vector_rttov.inc index ac78014a08..3f4dce9799 100644 --- a/var/da/da_radiance/da_get_innov_vector_rttov.inc +++ b/var/da/da_radiance/da_get_innov_vector_rttov.inc @@ -49,12 +49,30 @@ real,allocatable :: temp(:), temp2(:), temp3(:,:) real, allocatable :: em_mspps(:) ! emissivity caluclated using MSPPS algorithm real :: ts_mspps ! surface temperature calcualted using MSPPS algorithm + !For Zhuge and Zou cloud detection + real, allocatable :: geoht_full(:,:,:) + real :: geoht_pixel(kts:min(kte,kme-1)) + real :: tt_pixel(kts:min(kte,kme-1)) + real :: pp_pixel(kts:min(kte,kme-1)) + if (trace_use) call da_trace_entry("da_get_innov_vector_rttov") !------------------------------------------------------ ! [1.0] calculate the background bright temperature !------------------------------------------------------- + if ( use_clddet_zz ) then + allocate ( geoht_full(ims:ime,jms:jme,kms:kme-1) ) + do k = kms, kme-1 + do j = jms, jme + do i = ims, ime + geoht_full(i,j,k) = 0.5 * ( grid%ph_2(i,j,k) + grid%phb(i,j,k) + & + grid%ph_2(i,j,k+1) + grid%phb(i,j,k+1) ) / gravity + end do + end do + end do + end if + do inst = 1, iv%num_inst ! loop for sensor if ( iv%instid(inst)%num_rad < 1 ) cycle nlevels = iv%instid(inst)%nlevels @@ -99,7 +117,6 @@ real,allocatable :: temp(:), temp2(:), temp3(:,:) call da_interp_lin_3d (grid%xb%t, iv%instid(inst)%info, iv%instid(inst)%t (:,n1:n2)) call da_interp_lin_3d (grid%xb%q, iv%instid(inst)%info, iv%instid(inst)%mr(:,n1:n2)) - do n= n1,n2 do k=1, nlevels if (iv%instid(inst)%info%zk(k,n) <= 0.0) then @@ -132,6 +149,19 @@ real,allocatable :: temp(:), temp2(:), temp3(:,:) iv%instid(inst)%surftype(n) = 0 end if + if ( use_clddet_zz ) then + ! Find tropopause temperature for Zhuge and Zou Cloud Detection + do k = kts, min(kte,kme-1) + call da_interp_2d_partial ( grid%xb%t(:,:,k), iv%instid(inst)%info, k, n, n, tt_pixel(k) ) + call da_interp_2d_partial ( grid%xb%p(:,:,k), iv%instid(inst)%info, k, n, n, pp_pixel(k) ) + call da_interp_2d_partial ( geoht_full(:,:,k), iv%instid(inst)%info, k, n, n, geoht_pixel(k) ) + +! call da_interp_lin_2d ( grid%xb%t(:,:,k), iv%instid(inst)%info, k, n, n, tt_pixel(k) ) +! call da_interp_lin_2d ( grid%xb%p(:,:,k), iv%instid(inst)%info, k, n, n, pp_pixel(k) ) +! call da_interp_lin_2d ( geoht_full(:,:,k), iv%instid(inst)%info, k, n, n, geoht_pixel(k) ) + end do + call da_trop_wmo ( tt_pixel, geoht_pixel, pp_pixel, (min(kte,kme-1)-kts+1), tropt = iv%instid(inst)%tropt(n) ) + end if end do call da_interp_lin_2d (grid%xb % u10, iv%instid(inst)%info, 1, iv%instid(inst)%u10(n1:n2)) @@ -381,6 +411,8 @@ real,allocatable :: temp(:), temp2(:), temp3(:,:) end do ! end loop for sensor + if ( use_clddet_zz ) deallocate ( geoht_full ) + if (trace_use) call da_trace_exit("da_get_innov_vector_rttov") #else call da_error(__FILE__,__LINE__, & diff --git a/var/da/da_radiance/da_get_sat_angles.inc b/var/da/da_radiance/da_get_sat_angles.inc new file mode 100644 index 0000000000..440d13e8f3 --- /dev/null +++ b/var/da/da_radiance/da_get_sat_angles.inc @@ -0,0 +1,100 @@ +subroutine da_get_sat_angles ( lat, lon, sate_index, satzen, satazi ) +!------------------------------------------------- +! Purpose: calculate geostationary satellite_zenith_angle +! +! Menthod: Yang et al., 2017: Impact of assimilating GOES imager +! clear-sky radiance with a rapid refresh assimilation +! system for convection-permitting forecast over Mexico. +! J. Geophys. Res. Atmos., 122, 5472–5490 +!------------------------------------------------- + + implicit none + + real, intent(in) :: lat,lon + integer, intent(in) :: sate_index + real, intent(out) :: satzen + real, optional, intent(out) :: satazi + + real(r_double) :: alat, alon, alon_sat + real(r_double) :: theta, r_tmp, theta_tmp, gam, beta + + satzen = missing_r + if ( present( satazi ) ) satazi = missing_r + + if ( lat .ge. 90. .or. & + lat .le. -90. .or. & + lon .gt. 180. .or. & + lon .lt. -180. ) then + return + end if + + if (sate_index .eq. 11) then + alon_sat = -135. * deg2rad + else if (sate_index .eq. 12) then + alon_sat = -60. * deg2rad + else if (sate_index .eq. 13) then + alon_sat = -75. * deg2rad + else if (sate_index .eq. 14) then + alon_sat = -105. * deg2rad + else if (sate_index .eq. 15) then + alon_sat = -135. * deg2rad + else if (sate_index .eq. 16) then +! alon_sat = -75.2 * deg2rad !True Value? + alon_sat = -75. * deg2rad !Nominal Value +! else if (sate_index .eq. 17) then +! alon_sat = -137. * deg2rad + else + write(*,*)'this satellite is not included' + stop + end if + + alat = lat * deg2rad + alon = lon * deg2rad + theta = alon-alon_sat + + ! Yang et al., 2017 + + ! zenith +! r_tmp = (2*earth_radius*sin(abs(theta)/2.)-earth_radius*(1-cos(alat))*sin(abs(theta)/2.))**2 & +! +(2*earth_radius*sin(alat/2.))**2-(earth_radius*(1-cos(alat))*sin(abs(theta)/2.))**2 +! r_tmp = sqrt(r_tmp) +! satzen = 2*asin(r_tmp/earth_radius/2.) +! theta_tmp = atan(earth_radius*sin(satzen)/(satellite_height+earth_radius*(1-sin(satzen)))) +! satzen = (satzen+theta_tmp) / deg2rad !to degrees + + + ! Soler et al., Determination of Look Angles to Geostationary Communication Satellites, + ! Journal of Surveying Engineering, Vol. 120, No. 3, August, 1994. + ! follows spherical earth approximation + + ! zenith (up to 1 deg difference with code from Yang et al., 2017) + gam = acos( cos( alat ) * cos( abs( theta ) ) ) + r_tmp = ( satellite_height+earth_radius )**2 * & + ( 1.d0 + ( earth_radius / ( satellite_height+earth_radius ) )**2 - & + 2.d0 * ( earth_radius ) / ( satellite_height+earth_radius ) * cos(gam) ) + + if (r_tmp .lt. 0) return + + r_tmp = sqrt(r_tmp) + satzen = asin((satellite_height+earth_radius) / r_tmp * sin(gam)) / deg2rad !to degrees + + + ! azimuth + if ( present(satazi) ) then + beta = tan(alat) / tan(gam) + if (beta.gt.1.D0 .and. beta.lt.1.00000001D0) beta = 1.0D0 + beta = acos( beta ) / deg2rad !to degrees + + if ( lat.lt.0. .and. theta.le.0. ) & + satazi = beta + if ( lat.ge.0. .and. theta.le.0. ) & + satazi = 180.d0 - beta + if ( lat.ge.0. .and. theta.gt.0. ) & + satazi = 180.d0 + beta + if ( lat.lt.0. .and. theta.gt.0. ) & + satazi = 360.d0 - beta + end if + + return + +end subroutine da_get_sat_angles diff --git a/var/da/da_radiance/da_get_sat_angles_1d.inc b/var/da/da_radiance/da_get_sat_angles_1d.inc new file mode 100644 index 0000000000..64b65d71cf --- /dev/null +++ b/var/da/da_radiance/da_get_sat_angles_1d.inc @@ -0,0 +1,132 @@ +subroutine da_get_sat_angles_1d ( lat, lon, sate_index, satzen, satazi ) +!------------------------------------------------- +! Purpose: calculate geostationary satellite_zenith_angle +! +! Method: Yang et al., 2017: Impact of assimilating GOES imager +! clear-sky radiance with a rapid refresh assimilation +! system for convection-permitting forecast over Mexico. +! J. Geophys. Res. Atmos., 122, 5472–5490 +!------------------------------------------------- + + implicit none + + real, intent(in) :: lat(:),lon(:) + integer, intent(in) :: sate_index + real, intent(out) :: satzen(:) + real, optional, intent(out) :: satazi(:) + + integer :: n + real(r_double) :: alon_sat + real(r_double), allocatable :: alat(:), alon(:) + real(r_double), allocatable :: theta(:), r_tmp(:), theta_tmp(:), gam(:) + real(r_double), allocatable :: beta(:) + logical, allocatable :: valid_loc(:) + + satzen = missing_r + if (present(satazi)) satazi = missing_r + + n = size(lat) + if (n.le.0) return + + allocate( alat(n) ) + allocate( alon(n) ) + allocate( theta(n) ) + allocate( r_tmp(n) ) + allocate( theta_tmp(n) ) + allocate( gam(n) ) + allocate( valid_loc(n) ) + + !Define valid locations for vectorized operations + valid_loc = ( lat .lt. 90. .and. & + lat .gt. -90. .and. & + lon .le. 180. .and. & + lon .ge. -180. ) + + if (sate_index .eq. 11) then + alon_sat = -135. * deg2rad + else if (sate_index .eq. 12) then + alon_sat = -60. * deg2rad + else if (sate_index .eq. 13) then + alon_sat = -75. * deg2rad + else if (sate_index .eq. 14) then + alon_sat = -105. * deg2rad + else if (sate_index .eq. 15) then + alon_sat = -135. * deg2rad + else if (sate_index .eq. 16) then + alon_sat = -75.2 * deg2rad + else if (sate_index .eq. 17) then + alon_sat = -137.2 * deg2rad + else + write(*,*)'this satellite is not included' + stop + end if + + where ( valid_loc ) + alat = lat * deg2rad + alon = lon * deg2rad + theta = alon - alon_sat + elsewhere + alat = missing_r + alon = missing_r + theta = missing_r + gam = missing_r + r_tmp = missing_r + end where + + ! Yang et al., 2017 + ! zenith +! r_tmp = (2*earth_radius*sin(abs(theta)/2.)-earth_radius*(1-cos(alat))*sin(abs(theta)/2.))**2 & +! +(2*earth_radius*sin(alat/2.))**2-(earth_radius*(1-cos(alat))*sin(abs(theta)/2.))**2 +! r_tmp = sqrt(r_tmp) +! satzen = 2*asin(r_tmp/earth_radius/2.) +! theta_tmp = atan(earth_radius*sin(satzen)/(satellite_height+earth_radius*(1-sin(satzen)))) +! satzen = (satzen+theta_tmp) / deg2rad !to degrees + + + ! Soler et al., Determination of Look Angles to Geostationary Communication Satellites, + ! Journal of Surveying Engineering, Vol. 120, No. 3, August, 1994. + ! follows spherical earth approximation + + ! zenith (up to 1 deg difference with code from Yang et al., 2017) + where ( valid_loc ) + gam = acos( cos( alat ) * cos( abs( theta ) ) ) + r_tmp = ( satellite_height+earth_radius )**2 * & + ( 1.d0 + ( earth_radius / ( satellite_height+earth_radius ) )**2 - & + 2.d0 * ( earth_radius ) / ( satellite_height+earth_radius ) * cos( gam ) ) + end where + + valid_loc = (valid_loc .and. r_tmp.ge.0) + + where ( valid_loc ) + r_tmp = sqrt(r_tmp) + satzen = asin((satellite_height+earth_radius) / r_tmp * sin(gam)) / deg2rad !to degrees + end where + + + ! azimuth + if ( present(satazi) ) then + allocate( beta(n) ) + beta = missing_r + where ( valid_loc ) & + beta = tan(alat) / tan(gam) + where ( beta.gt.1._r_double .and. & + beta.lt.1.00000001_r_double .and. valid_loc ) & + beta = 1.0_r_double + where ( valid_loc ) & + beta = acos( beta ) / deg2rad !to degrees + where ( lat.lt.0. .and. theta.le.0. .and. valid_loc ) & + satazi = beta + where ( lat.ge.0. .and. theta.le.0. .and. valid_loc ) & + satazi = 180.d0 - beta + where ( lat.ge.0. .and. theta.gt.0. .and. valid_loc ) & + satazi = 180.d0 + beta + where ( lat.lt.0. .and. theta.gt.0. .and. valid_loc ) & + satazi = 360.d0 - beta + deallocate( beta ) + end if + + deallocate( alat, alon, theta, r_tmp, theta_tmp, gam, valid_loc ) + + return + +end subroutine da_get_sat_angles_1d diff --git a/var/da/da_radiance/da_get_solar_angles.inc b/var/da/da_radiance/da_get_solar_angles.inc new file mode 100644 index 0000000000..0f1fc12b01 --- /dev/null +++ b/var/da/da_radiance/da_get_solar_angles.inc @@ -0,0 +1,215 @@ +subroutine da_get_solar_angles( yr, mt, dy, hr, mn, sc, & + lat, lon, solzen, solazi ) + !--------------------------------------------------------------------------------+ + ! This subroutine calculates the local azimuth and zenith angles of the sun at | + ! a specific location and time using an approximation to equations used | + ! to generate tables in The Astronomical Almanac. | + ! Refraction correction is added so sun position is apparent one. | + ! | + ! Michalsky, Joseph J., The Astronomical Almanac's algorithm for approximate | + ! solar position (1950-2050), Solar Energy, Vol. 40, No. 3, pp227-235, 1988. | + ! | + ! AND | + ! | + ! U.S. Gov't Printing Office, Washington,D.C. (1985). | + ! | + ! Provides solar zenith and azimuth angles with errors within ±0.01 deg. | + ! for the time period 1950-2050. | + ! | + ! INPUT parameters | + ! yr, mt, dy, hr, mn, sc = integer date/time quantities | + ! lat = latitude in degrees (north is positive) | + ! lon = longitude in degrees (east is positive) | + ! | + ! OUTPUT parameters | + ! solazi = sun azimuth angle (measured east from north, 0 to 360 degs) | + ! solzen = sun elevation angle (degs) | + ! | + ! Converted from F77 to F90 by Juan Pablo Justiniano | + ! (https://github.com/jpjustiniano/Subroutines) | + ! | + ! For more accurate algorithms (±0.0003 deg.) across longer periods of time, | + ! refer to the National Renewable Energy Laboratory (NREL) Solar Postion | + ! Algorithm (SPA), available in C, Matlab, and Python: | + ! - https://rredc.nrel.gov/solar/codesandalgorithms/spa | + ! - https://www.mathworks.com/matlabcentral/fileexchange/59903-nrel-s-solar-position-algorithm-spa | + ! - https://sunpy.org | + !--------------------------------------------------------------------------------+ + + implicit none + + integer, intent(in) :: yr, mt, dy, hr, mn, sc + real, intent(in) :: lat + real, intent(in) :: lon + real, intent(out) :: solazi + real, intent(out) :: solzen + + real(r_double) :: latrad + real(r_double) :: delta, ju, jmod, time, gmst, lmst + real(r_double) :: mnlon, mnanom, eclon, oblqec + real(r_double) :: num, den, ra, dec, ha + real(r_double) :: elev, refrac !, elc + + ! Conversion to Julian day from MJD reference time: 1978 Jan 01 00:12:00 (see da_get_julian_time) + real(r_double), parameter :: jd_jmod = 43510.0 ! = 2443510.0 - 2.4e6 (rel. adjust improves precision of ±) + +! ! Conversion to Julian day from MJD reference time: 1978 Jan 01 00:00:00 (see da_get_julian_time) +! real(r_double), parameter :: jd_jmod = 43509.5 ! = 2443510.0 - 2.4e6 (rel. adjust improves precision of ±) + + solzen = missing_r + solazi = missing_r + if ( lat .gt. 90. .or. & + lat .lt. -90. .or. & + lon .gt. 180. .or. & + lon .lt. -180. ) then + return + end if + + call da_get_julian_time( yr, mt, dy, hr, mn, jmod ) + ju = jmod / 1440.0 + real(sc,r_double) / 86400.0 + jd_jmod + + ! Calculate ecliptic coordinates (depends on time [days] since noon 1 Jan, 2000) + ! 51545.0 + 2.4e6 = noon 1 Jan, 2000 + time = ju - 51545.0 + + ! Force mean longitude between 0 and 360 degs + mnlon = 280.460 + 0.9856474 * time + mnlon = mod( mnlon, 360. ) + if ( mnlon.lt.0. ) mnlon = mnlon + 360. + + ! Mean anomaly in radians between 0 and 2*pi + mnanom = 357.528 + 0.9856003 * time + mnanom = mod( mnanom, 360. ) + if ( mnanom.lt.0. ) mnanom = mnanom + 360. + mnanom = mnanom * deg2rad + + ! Compute the ecliptic longitude and obliquity of ecliptic in radians + eclon = mnlon + 1.915*sin( mnanom ) + 0.020*sin( 2.*mnanom ) + eclon = mod( eclon, 360. ) + + if ( eclon.lt.0. ) eclon = eclon + 360. + + oblqec = 23.439 - 0.0000004*time + eclon = eclon * deg2rad + oblqec = oblqec * deg2rad + + ! Calculate right ascension and force between 0 and 2*pi + num = cos( oblqec ) * sin( eclon ) + den = cos( eclon ) + ra = atan( num/den ) + if ( den.lt.0 ) then + ra = ra + PI + elseif ( num.lt.0 ) then + ra = ra + 2.0*PI + endif + + ! Calculate declination in radians + ! (asin varies between -pi/2 to pi/2) + dec = asin( sin( oblqec ) * sin( eclon ) ) + + ! Calculate Greenwich mean sidereal time in hours +! gmst = 6.697375 + 0.0657098242*time + real(hr,r_double) + real(mn,r_double) / 60. + real(sc,r_double) / 3600. + gmst = 6.697375 + 0.0657098242*time + real(hr * 3600 + mn * 60 + sc, r_double) / 3600. + + ! Hour not changed to sidereal time since 'time' includes the fractional day + gmst = mod( gmst, 24. ) + if ( gmst.lt.0. ) gmst = gmst + 24. + + ! Calculate local mean sidereal time in radians + lmst = gmst + lon / 15. + lmst = mod( lmst, 24. ) + if ( lmst.lt.0. ) lmst = lmst + 24. + lmst = lmst * 15. * deg2rad + + + ! Calculate hour angle in radians between -pi and pi + ha = lmst - ra + if ( ha .lt. -PI ) ha = ha + 2.0*PI + if ( ha .gt. PI ) ha = ha - 2.0*PI + + ! Change latitude to radians + latrad = lat * deg2rad + + ! From this point on: + ! mnlon in degs, gmst in hours, ju in days minus 2.4e6; + ! mnanom, eclon, oblqec, ra, lmst, and ha in radians + + ! Calculate elevation (90 - zenith) + ! (asin varies between -pi/2 to pi/2) + elev = asin( sin( dec ) * sin( latrad ) + cos( dec ) * cos( latrad ) * cos( ha ) ) + + ! Night-time angles are inconsequential + if ( elev < 0. ) return + + ! Calculate azimuth + ! (asin varies between -pi/2 to pi/2) + solazi = asin( -cos( dec ) * sin( ha ) / cos( elev ) ) + +!JJG: From J.P. Justiniano (not in Michalsky, causes differences with NREL SPA) +!! This puts azimuth between 0 and 2*pi radians +! if ( sin(dec) - sin(elev) * sin(latrad) .ge. 0. ) then +! if ( sin(solazi) .lt. 0. ) solazi = solazi + 2.0*PI +! else +! solazi = PI - solazi +! endif + + +! ! When solazi=90 degs, elev == elcritical = asin( sin(dec) / sin(latrad) ) +! JJG: elc is undefined when sin(dec) / sin(latrad) is outside [-1,1] or dec > latrad when both are positive...need better method to determine quadrant + !ORIGINAL: + !elc = asin( sin( dec ) / sin( latrad ) ) + !if ( elev.ge.elc ) solazi = PI - solazi + !if ( elev.le.elc .and. ha.gt.0. ) solazi = 2.0*PI + solazi + + !Updated according to Eq. 3.18 at https://www.powerfromthesun.net/Book/chapter03/chapter03.html + ! "Power From The Sun" is the great new website by William Stine and Michael Geyer. It features + ! a revised and updated (and free!) version of "Solar Energy Systems Design" by W.B.Stine and + ! R.W.Harrigan (John Wiley and Sons, Inc. 1986) retitled "Power From The Sun", along with + ! resources we hope you will find useful in learning about solar energy. + if ( cos(ha) < ( tan(dec) / tan(latrad) ) ) then + solazi = 2.0*PI + solazi + else + solazi = PI - solazi + end if + + ! Convert az to degs, force between 0 and 2*pi + solazi = solazi / deg2rad + solazi = mod( solazi, 360. ) + + ! Calculate refraction correction for US stan. atmosphere + ! (need to have elev in degs before calculating correction) + elev = elev / deg2rad + + !JJG: Added these bounds (should not need them) + !Keep elevation between -90. to +90. + if ( elev.lt.-90. ) & + elev = - (180. + elev) + if ( elev.gt.90. ) & + elev = 180. - elev + +! ! Michalsky (1988) +! if ( elev.gt. - 0.56 ) then +! refrac = 3.51579 * ( 0.1594 + 0.0196*elev + 0.00002*elev**2 ) / & +! ( 1. + 0.505*elev + 0.0845*elev**2 ) +! else +! refrac = 0.56 +! endif + + !J.P. Justiniano (not in Michalsky, more accurate than above?) + if ( elev.ge.19.225 ) then + refrac = 0.00452 * 3.51823 / tan( elev*deg2rad ) + else if ( elev.gt.-0.766 .and. elev.lt.19.225 ) then + refrac = 3.51579 * ( 0.1594 + 0.0196 * elev + 0.00002*elev**2 ) / & + ( 1. + 0.505*elev + 0.0845*elev**2 ) + else + refrac = 0.0 + end if + + ! note that 3.51579=1013.25 mb/288.2 C + + elev = elev + refrac + + ! Convert elevation to topocentric zenith + solzen = 90.0_r_kind - elev + +end subroutine da_get_solar_angles diff --git a/var/da/da_radiance/da_get_solar_angles_1d.inc b/var/da/da_radiance/da_get_solar_angles_1d.inc new file mode 100644 index 0000000000..aff7a519b5 --- /dev/null +++ b/var/da/da_radiance/da_get_solar_angles_1d.inc @@ -0,0 +1,253 @@ +subroutine da_get_solar_angles_1d( yr, mt, dy, hr, mn, sc, & + lat, lon, solzen, solazi ) + !--------------------------------------------------------------------------------+ + ! This subroutine calculates the local azimuth and zenith angles of the sun at | + ! a specific location and time using an approximation to equations used | + ! to generate tables in The Astronomical Almanac. | + ! Refraction correction is added so sun position is apparent one. | + ! | + ! Michalsky, Joseph J., The Astronomical Almanac's algorithm for approximate | + ! solar position (1950-2050), Solar Energy, Vol. 40, No. 3, pp227-235, 1988. | + ! | + ! AND | + ! | + ! U.S. Gov't Printing Office, Washington,D.C. (1985). | + ! | + ! Provides solar zenith and azimuth angles with errors within ±0.01 deg. | + ! for the time period 1950-2050. | + ! | + ! INPUT parameters | + ! yr, mt, dy, hr, mn, sc = integer date/time quantities | + ! lat = latitude in degrees (north is positive) | + ! lon = longitude in degrees (east is positive) | + ! | + ! OUTPUT parameters | + ! solazi = sun azimuth angle (measured east from north, 0 to 360 degs) | + ! solzen = sun elevation angle (degs) | + ! | + ! Converted from F77 to F90 by Juan Pablo Justiniano | + ! (https://github.com/jpjustiniano/Subroutines) | + ! | + ! For more accurate algorithms (±0.0003 deg.) across longer periods of time, | + ! refer to the National Renewable Energy Laboratory (NREL) Solar Postion | + ! Algorithm (SPA), available in C, Matlab, and Python: | + ! - https://rredc.nrel.gov/solar/codesandalgorithms/spa | + ! - https://www.mathworks.com/matlabcentral/fileexchange/59903-nrel-s-solar-position-algorithm-spa | + ! - https://sunpy.org | + !--------------------------------------------------------------------------------+ + + implicit none + + integer, intent(in) :: yr, mt, dy, hr, mn, sc + real, intent(in) :: lat(:) + real, intent(in) :: lon(:) + real, intent(out) :: solazi(:) + real, intent(out) :: solzen(:) + + real(r_double), allocatable :: latrad(:) + real(r_double) :: delta, ju, jmod, time, gmst + + real(r_double), allocatable :: lmst(:), ha(:) + real(r_double) :: mnlon, mnanom, eclon, oblqec + real(r_double) :: num, den, ra, dec + real(r_double), allocatable :: elev(:), refrac(:) !, elc(:) + logical, allocatable :: valid_loc(:) + + ! Conversion to Julian day from MJD reference time: 1978 Jan 01 00:12:00 (see da_get_julian_time) + real(r_double), parameter :: jd_jmod = 43510.0 ! = 2443510.0 - 2.4e6 (rel. adjust improves precision of ±) + +! ! Conversion to Julian day from MJD reference time: 1978 Jan 01 00:00:00 (see da_get_julian_time) +! real(r_double), parameter :: jd_jmod = 43509.5 ! = 2443510.0 - 2.4e6 (rel. adjust improves precision of ±) + + + integer :: n + + n = size(lat) + allocate( latrad(n) ) + allocate( lmst(n) ) + allocate( ha(n) ) + allocate( elev(n) ) +! allocate( elc(n) ) + allocate( refrac(n) ) + allocate( valid_loc(n) ) + + call da_get_julian_time( yr, mt, dy, hr, mn, jmod ) + ju = jmod / 1440.0 + real(sc,r_double) / 86400.0 + jd_jmod + + ! Calculate ecliptic coordinates (depends on time [days] since noon 1 Jan, 2000) + ! 51545.0 + 2.4e6 = noon 1 Jan, 2000 + time = ju - 51545.0 + + ! Force mean longitude between 0 and 360 degs + mnlon = 280.460 + 0.9856474 * time + mnlon = mod( mnlon, 360. ) + if( mnlon.lt.0. ) mnlon = mnlon + 360. + + ! Mean anomaly in radians between 0 and 2*pi + mnanom = 357.528 + 0.9856003 * time + mnanom = mod( mnanom, 360. ) + if( mnanom.lt.0. ) mnanom = mnanom + 360. + mnanom = mnanom * deg2rad + + ! Compute the ecliptic longitude and obliquity of ecliptic in radians + eclon = mnlon + 1.915*sin( mnanom ) + 0.020*sin( 2.*mnanom ) + eclon = mod( eclon, 360. ) + + if ( eclon.lt.0. ) eclon = eclon + 360. + + oblqec = 23.439 - 0.0000004*time + eclon = eclon * deg2rad + oblqec = oblqec * deg2rad + + ! Calculate right ascension and force between 0 and 2*pi + num = cos( oblqec ) * sin( eclon ) + den = cos( eclon ) + ra = atan( num/den ) + if ( den.lt.0 ) then + ra = ra + PI + elseif ( num.lt.0 ) then + ra = ra + 2.0*PI + endif + + ! Calculate declination in radians + dec = asin( sin( oblqec ) * sin( eclon ) ) + + ! Calculate Greenwich mean sidereal time in hours +! gmst = 6.697375 + 0.0657098242*time + real(hr,r_double) + real(mn,r_double) / 60. + real(sc,r_double) / 3600. + gmst = 6.697375 + 0.0657098242*time + real(hr * 3600 + mn * 60 + sc, r_double) / 3600. + + ! Hour not changed to sidereal time since 'time' includes the fractional day + gmst = mod( gmst, 24. ) + if( gmst.lt.0. ) gmst = gmst + 24. + + !Define valid locations for vectorized operations + valid_loc = ( lat .le. 90. .and. & + lat .ge. -90. .and. & + lon .le. 180. .and. & + lon .ge. -180. ) + + ! Calculate local mean sidereal time in radians + where ( valid_loc ) + lmst = gmst + lon / 15. + lmst = mod( lmst, 24. ) + end where + where ( lmst.lt.0. .and. valid_loc ) + lmst = lmst + 24. + end where + where ( valid_loc ) + lmst = lmst * 15. * deg2rad + end where + + + ! Calculate hour angle in radians between -pi and pi + where ( valid_loc ) + ha = lmst - ra + end where + where ( ha .lt. -PI .and. valid_loc ) ha = ha + 2.0*PI + where ( ha .gt. PI .and. valid_loc ) ha = ha - 2.0*PI + + ! Change latitude to radians + latrad = missing_r + where ( valid_loc ) + latrad = lat * deg2rad + end where + + ! From this point on: + ! mnlon in degs, gmst in hours, jd in days if 2.4e6 added; + ! mnanom, eclon, oblqec, ra, lmst, and ha in radians + + ! Calculate elevation (90 - zenith) + ! (asin varies between -pi/2 to pi/2) + where ( valid_loc ) + elev = asin( sin( dec ) * sin( latrad ) + cos( dec ) * cos( latrad ) * cos( ha ) ) + end where + + ! Night-time angles are inconsequential + valid_loc = (valid_loc .and. elev.ge.0.) + + ! Calculate azimuth + ! (asin varies between -pi/2 to pi/2) + solazi = missing_r + where ( valid_loc ) + solazi = asin( -cos( dec ) * sin( ha ) / cos( elev ) ) + end where + +!JJG: From J.P. Justiniano (not in Michalsky, causes differences with NREL SPA) +!! This puts azimuth between 0 and 2*pi radians +! where ( sin(dec) - sin(elev) * sin(latrad) .ge. 0. ) then +! where ( sin(solazi) .lt. 0. ) solazi = solazi + 2.0*PI +! elsewhere +! solazi = PI - solazi +! endif + + ! When solazi=90 degs, elev == elcritical = asin( sin(dec) / sin(latrad) ) +! JJG: elc is undefined when sin(dec) / sin(latrad) is outside [-1,1] or dec > latrad when both are positive...need better method to determine quadrant + !where ( valid_loc ) + ! elc = asin( sin( dec ) / sin( latrad ) ) + !end where + !where ( elev.ge.elc .and. valid_loc ) solazi = PI - solazi + !where ( elev.le.elc .and. ha.gt.0. .and. valid_loc ) solazi = 2.0*PI + solazi + + !Updated according to Eq. 3.18 at https://www.powerfromthesun.net/Book/chapter03/chapter03.html + ! "Power From The Sun" is the great new website by William Stine and Michael Geyer. It features + ! a revised and updated (and free!) version of "Solar Energy Systems Design" by W.B.Stine and + ! R.W.Harrigan (John Wiley and Sons, Inc. 1986) retitled "Power From The Sun", along with + ! resources we hope you will find useful in learning about solar energy. + where ( valid_loc .and. cos(ha) < ( tan(dec) / tan(latrad) ) ) + solazi = 2.0*PI + solazi + elsewhere ( valid_loc ) + solazi = PI - solazi + end where + + ! Convert az to degs, force between 0 and 2*pi + where ( valid_loc ) + solazi = solazi / deg2rad + end where + solazi = mod( solazi, 360. ) + + ! Calculate refraction correction for US stan. atmosphere + ! (need to have elev in degs before calculating correction) + where ( valid_loc ) + elev = elev / deg2rad + end where + + !JJG: Added these bounds (should not need them) + !Keep elevation between -90. to +90. + where ( valid_loc .and. elev.lt.-90.) & + elev = - (180. + elev) + where ( valid_loc .and. elev.gt.90.) & + elev = 180. - elev + +! ! Michalsky (1988) +! where ( elev.gt. - 0.56 ) +! refrac = 3.51579 * ( 0.1594 + 0.0196*elev + 0.00002*elev**2 ) / & +! ( 1. + 0.505*elev + 0.0845*elev**2 ) +! elsewhere +! refrac = 0.56 +! end where + + !J.P. Justiniano (not in Michalsky, more accurate than above?) + where ( elev.ge.19.225 ) + refrac = 0.00452 * 3.51823 / tan( elev*deg2rad ) + elsewhere ( elev.gt.-0.766 .and. elev.lt.19.225 ) + refrac = 3.51579 * ( 0.1594 + 0.0196 * elev + 0.00002*elev**2 ) / & + ( 1. + 0.505*elev + 0.0845*elev**2 ) + elsewhere + refrac = 0.0 + end where + ! note that 3.51579=1013.25 mb/288.2 C + + where ( valid_loc ) + elev = elev + refrac + end where + + + ! Convert elevation to topocentric zenith + solzen = missing_r + where (valid_loc) + solzen = 90.0_r_kind - elev + end where + + deallocate( latrad, lmst, ha, elev, refrac, valid_loc ) + +end subroutine da_get_solar_angles_1d diff --git a/var/da/da_radiance/da_initialize_rad_iv.inc b/var/da/da_radiance/da_initialize_rad_iv.inc index 8c6de31102..4cc7740f33 100644 --- a/var/da/da_radiance/da_initialize_rad_iv.inc +++ b/var/da/da_radiance/da_initialize_rad_iv.inc @@ -93,6 +93,11 @@ subroutine da_initialize_rad_iv (i, n, iv, p) iv%instid(i)%tb_imp(:,n) = 0.0 iv%instid(i)%rad_xb(:,n) = 0.0 iv%instid(i)%rad_obs(:,n) = 0.0 + !if ( associated( p % rad_obs ) ) then + ! iv%instid(i)%rad_obs(:,n) = p%rad_obs(:) + !else + ! iv%instid(i)%rad_obs(:,n) = 0.0 + !end if iv%instid(i)%rad_ovc(:,:,n) = 0.0 iv%instid(i)%emiss(:,n) = 0.0 iv%instid(i)%scanpos(n) = p%scanpos @@ -113,14 +118,20 @@ subroutine da_initialize_rad_iv (i, n, iv, p) do iy = 1, iv%instid(i)%superob_width do ix = 1, iv%instid(i)%superob_width iv%instid(i)%superob(ix,iy)%tb_obs(:,n) = p % superob(ix,iy) % tb_obs(:,1) - iv%instid(i)%superob(ix,iy)%cld_qc(n)%RTCT = p % superob(ix,iy) % cld_qc(1) % RTCT - iv%instid(i)%superob(ix,iy)%cld_qc(n)%RFMFT = p % superob(ix,iy) % cld_qc(1) % RFMFT - iv%instid(i)%superob(ix,iy)%cld_qc(n)%TEMPIR = p % superob(ix,iy) % cld_qc(1) % TEMPIR + if (index(iv%instid(i)%rttovid_string, 'abi') > 0) then + if ( allocated ( p % superob(ix,iy) % cld_qc(1) % tb_stddev_3x3 ) ) & + iv%instid(i)%superob(ix,iy)%cld_qc(n)%tb_stddev_3x3(:) = p % superob(ix,iy) % cld_qc(1) % tb_stddev_3x3(:) + end if + if (index(iv%instid(i)%rttovid_string, 'ahi') > 0) then iv%instid(i)%superob(ix,iy)%cld_qc(n)%tb_stddev_10 = p % superob(ix,iy) % cld_qc(1) % tb_stddev_10 iv%instid(i)%superob(ix,iy)%cld_qc(n)%tb_stddev_13 = p % superob(ix,iy) % cld_qc(1) % tb_stddev_13 iv%instid(i)%superob(ix,iy)%cld_qc(n)%tb_stddev_14 = p % superob(ix,iy) % cld_qc(1) % tb_stddev_14 + end if + iv%instid(i)%superob(ix,iy)%cld_qc(n)%CIRH2O = p % superob(ix,iy) % cld_qc(1) % CIRH2O + iv%instid(i)%superob(ix,iy)%cld_qc(n)%RTCT = p % superob(ix,iy) % cld_qc(1) % RTCT + iv%instid(i)%superob(ix,iy)%cld_qc(n)%RFMFT = p % superob(ix,iy) % cld_qc(1) % RFMFT + iv%instid(i)%superob(ix,iy)%cld_qc(n)%TEMPIR = p % superob(ix,iy) % cld_qc(1) % TEMPIR iv%instid(i)%superob(ix,iy)%cld_qc(n)%terr_hgt = p % superob(ix,iy) % cld_qc(1) % terr_hgt - iv%instid(i)%superob(ix,iy)%cld_qc(n)%CIRH2O = p % superob(ix,iy) % cld_qc(1) % CIRH2O end do end do end if diff --git a/var/da/da_radiance/da_qc_goesabi.inc b/var/da/da_radiance/da_qc_goesabi.inc new file mode 100644 index 0000000000..ec860279e9 --- /dev/null +++ b/var/da/da_radiance/da_qc_goesabi.inc @@ -0,0 +1,706 @@ +subroutine da_qc_goesabi (it, isens, nchan, ob, iv) + + !--------------------------------------------------------------------------- + ! Purpose: perform quality control for abi data. + ! To be developed: built in cloud_detection method + !--------------------------------------------------------------------------- + + implicit none + + integer, intent(in) :: it ! outer loop count + integer, intent(in) :: isens ! sensor index. + integer, intent(in) :: nchan ! number of channel + type (y_type), intent(in) :: ob ! Observation structure. + type (iv_type), intent(inout) :: iv ! O-B structure. + + ! local variables + logical :: lmix, cloud_detection + integer :: n,k,isflg,ios,fgat_rad_unit + integer :: ngood(nchan),nrej(nchan),nrej_omb_abs(nchan), & + nrej_omb_std(nchan),nrej_eccloud(nchan), & + nrej_clw(nchan),num_proc_domain, & + nrej_mixsurface,nrej_land + + ! isflg: SEA(0),ICE(1),LAND(2),SNOW(3),MSEA(4),MICE(5),MLND(6),MSNO(7) + integer, parameter :: sea_flag = 0 + integer, parameter :: ice_flag = 1 + integer, parameter :: land_flag = 2 + integer, parameter :: snow_flag = 3 + integer, parameter :: msea_flag = 4 + integer, parameter :: mice_flag = 5 + integer, parameter :: mland_flag = 6 + integer, parameter :: msnow_flag = 7 + +! ------- + real :: inv_grosscheck + + character(len=30) :: filename + + logical :: print_cld_debug + + !! Additional variables used by Harnish, Weissmann, & Perianez (2016) + real :: BTlim(nchan), cloud_mean(nchan) + real, allocatable :: cld_impact(:,:), cld_impact_global(:,:), weights_global(:) + integer :: buf_i, buf_f, nbuf, nlocal, nglobal, iproc + real, parameter :: camin = 0.0 !Harnisch et al. (2016) + !real, parameter :: camin = 0.5 !Okamoto et al. (2013) + + !! Additional variables used by Zhuge and Zou (2017) + integer :: itest + logical :: reject_clddet + real :: crit_clddet + real :: rad_O14, rad_M14, rad_tropt + real :: rad_o_ch7, rad_b_ch7, rad_o_ch14, rad_b_ch14 + real :: Relaz, Glintzen + real :: wave_num(10) + real :: plbc1(10), plbc2(10) + real :: plfk1(10), plfk2(10) + integer, parameter :: num_clddet_tests = 10 + integer, parameter :: num_clddet_cats = 4 + real :: eps_clddet(num_clddet_tests+2,num_clddet_cats) + integer :: index_clddet(num_clddet_tests), offset_clddet + integer :: isflgs_clddet(num_clddet_cats) + logical :: qual_clddet(num_clddet_cats) + character(len=10) :: crit_names_clddet(num_clddet_tests) + integer :: nrej_clddet(nchan,num_clddet_tests) + integer :: superob_center + integer*2 :: clddet_tests(iv%instid(isens)%superob_width, & + iv%instid(isens)%superob_width, & + num_clddet_tests) + integer :: isuper, jsuper + + real, pointer :: tb_obs(:,:), tb_xb(:,:), tb_inv(:,:), tb_xb_clr(:,:), & + cloud_obs(:,:), cloud_mod(:,:) + integer :: tb_qc(nchan) + + real :: big_num + + ! note: these values are constant across channels + real, parameter :: C1=1.19104276e-5 ! = 2 * h * c**2 mWm-2sr-1(cm-1)-4 + real, parameter :: C2=1.43877516 ! = h * c / b = 1.43877 K(cm-1)-1 + ! h = Planck's constant + ! b = Boltzmann constant + ! c = velocity of light + + integer, parameter :: ch7 = 1 + integer, parameter :: ch10 = 4 + integer, parameter :: ch14 = 8 + integer, parameter :: ch15 = 9 + + if (trace_use) call da_trace_entry("da_qc_goesabi") + +!! if (iv%instid(isens)%num_rad <= 0) return + + ! These values can change as SRF (spectral response function) is updated + ! It is recommended to acquire these from L1B files, not copy them from GOES R PUG L1b Vol. 3 + wave_num(1:10) = (/2570.373, 1620.528, 1443.554, 1363.228, 1184.220, & + 1040.891, 968.001, 894.000, 815.294, 753.790/) + plbc1(1:10) = (/0.43361, 1.55228, 0.34427, 0.05651, 0.18733, & + 0.09102, 0.07550, 0.22516, 0.21702, 0.06266/) + plbc2(1:10) = (/0.99939, 0.99667, 0.99918, 0.99986, 0.99948, & + 0.99971, 0.99975, 0.99920, 0.99916, 0.99974/) + + plfk1 = C1 * wave_num**3 + plfk2 = C2 * wave_num + + crit_names_clddet(1) = "rtct" + crit_names_clddet(2) = "etrop" + crit_names_clddet(3) = "pfmft" + crit_names_clddet(4) = "nfmft" + crit_names_clddet(5) = "rfmft" + crit_names_clddet(6) = "cirh2o" + crit_names_clddet(7) = "emiss4" + crit_names_clddet(8) = "ulst" + crit_names_clddet(9) = "notc" + crit_names_clddet(10) = "tempir" + + big_num = huge(big_num) + !! Table 4 from Zhuge X. and Zou X. JAMC, 2016. [modified from ABI Cloud Mask Algorithm] + !ocean land snow ice (assume same as snow) + eps_clddet = transpose( reshape( (/ & + 3.2, 4.1, big_num, big_num & + , 0.1, 0.3, 0.4, 0.4 & + , 0.8, 2.5, 1.0, 1.0 & + , 1.0, 2.0, 5.0, 5.0 & + , 0.7, 1.0, big_num, big_num & + , 0.7, 0.7, 0.7, 0.7 & + , 0.1, 0.46, 0.3, 0.3 & ! Land values: 0.46 in ABI CM; 0.2 in ZZ16 + , 2.86, big_num, big_num, big_num & + , 0.05, 0.1, 0.12, 0.12 & + , 15., 21., 10., 10. & + , 11., 15., 4.5, 4.5 & + , 2.0, 2.0, 2.0, 2.0 & + /), (/ size(eps_clddet, 2), size(eps_clddet, 1) /)) ) + index_clddet = (/1, 2, 3, 4, 5, 6, 7, 9, 10, 12/) + isflgs_clddet = (/sea_flag, land_flag, snow_flag, ice_flag/) + + + ngood(:) = 0 + nrej(:) = 0 + nrej_omb_abs(:) = 0 + nrej_omb_std(:) = 0 + nrej_eccloud(:) = 0 + nrej_clw(:) = 0 + nrej_mixsurface = 0 + nrej_land = 0 + num_proc_domain = 0 + + nrej_clddet = 0 + + tb_xb => iv%instid(isens)%tb_xb + tb_inv => iv%instid(isens)%tb_inv + +! print_cld_debug = .true. + print_cld_debug = .false. + + inv_grosscheck = 15.0 + if ( crtm_cloud ) inv_grosscheck = 80.0 + if ( use_satcv(2) ) inv_grosscheck = 100.0 + + if ( crtm_cloud ) then + tb_xb_clr => iv%instid(isens)%tb_xb_clr + + !JJG: for Harnisch et al. BTlim using stats from CONUS 9km 2-hr WRF forecast from GSI analysis + BTlim(1) = 269.5 +!3km 2/3 CONUS stats 01 MAY 2018 (mean) + BTlim(2) = 237.0 + BTlim(3) = 249.0 + BTlim(4) = 261.0 +!3km 2/3 CONUS stats 01 MAY 2018 (median) +! BTlim(2) = 231.5 +! BTlim(3) = 240.0 +! BTlim(4) = 250.5 + BTlim(5) = 271.0 + BTlim(6) = 258.0 + BTlim(7) = 272.0 + BTlim(8) = 268.0 + BTlim(9) = 270.5 + BTlim(10) = 258.0 + + cloud_obs => iv%instid(isens)%cloud_obs + cloud_obs = missing_r + + cloud_mod => iv%instid(isens)%cloud_mod + cloud_mod = missing_r + else + tb_xb_clr => iv%instid(isens)%tb_xb + end if + + superob_center = abi_superob_halfwidth + 1 + + ABIPixelQCLoop: do n= iv%instid(isens)%info%n1,iv%instid(isens)%info%n2 + tb_obs => ob%instid(isens)%tb + + if (iv%instid(isens)%info%proc_domain(1,n)) & + num_proc_domain = num_proc_domain + 1 + + ! 0.0 initialise QC by flags assuming good obs + !----------------------------------------------------------------- + tb_qc = qc_good + iv%instid(isens)%cloud_flag(:,n) = 0 + + ! 1.0 reject all channels over mixed surface type + !------------------------------------------------------ + isflg = iv%instid(isens)%isflg(n) + lmix = (isflg==msea_flag) .or. & + (isflg==mland_flag) .or. & + (isflg==msnow_flag) .or. & + (isflg==mice_flag) + + if (lmix) then + tb_qc = qc_bad + if (iv%instid(isens)%info%proc_domain(1,n)) & + nrej_mixsurface = nrej_mixsurface + 1 + end if + + if ( isflg .ne. sea_flag ) then + do k = 1, nchan + if ( all(k .ne. (/ 2, 3, 4 /)) .and. only_sea_rad ) then + tb_qc(k) = qc_bad + nrej_land = nrej_land + 1 + end if + end do + end if + + ! 2.0 check iuse + !----------------------------------------------------------------- + where (satinfo(isens)%iuse(:) == -1) tb_qc = qc_bad + + ! 3.0 check cloud + !----------------------------------------------------------------- + if (.not. crtm_cloud ) then + if (iv%instid(isens)%clwp(n) >= 0.2) then + tb_qc = qc_bad + if (iv%instid(isens)%info%proc_domain(1,n)) & + nrej_clw(:) = nrej_clw(:) + 1 + end if + + cloud_detection=.false. + if (cloud_detection) then + if (iv%instid(isens)%landsea_mask(n) == 0 ) then + if ( ( tb_xb(3,n) - tb_obs(3,n) ) > 3.5) then + tb_qc = qc_bad + if (iv%instid(isens)%info%proc_domain(1,n)) & + nrej_eccloud(:) = nrej_eccloud(:) + 1 + end if + else + if ( ( tb_xb(3,n) - tb_obs(3,n) ) > 2.5) then + tb_qc = qc_bad + if (iv%instid(isens)%info%proc_domain(1,n)) & + nrej_eccloud(:) = nrej_eccloud(:) + 1 + end if + end if + end if + end if + + abi_clddet: if ( use_clddet_zz ) then + + !!=============================================================================== + !!=============================================================================== + !! + !! 4.0 ABI IR-only Cloud Mask Algorithm, combines: + !! (*) Heidinger A. and Straka W., ABI Cloud Mask, version 3.0, 11 JUN, 2013. + !! (*) Zhuge X. and Zou X. JAMC, 2016. + !! + !!=============================================================================== + !!=============================================================================== + +!JJGDEBUG +! print_cld_debug = iv%instid(isens)%info%proc_domain(1,n) + if (print_cld_debug) write(stdout,'(A,I8,*(2x,F10.4:))') 'PIXEL_DEBUG1: ', n, & + tb_inv(:,n) + if (print_cld_debug) write(stdout,'(A,I8,*(2x,F10.4:))') 'PIXEL_DEBUG2: ', n, & + tb_xb_clr(:,n) + if (print_cld_debug) write(stdout,'(A,I8,*(2x,F10.4:))') 'PIXEL_DEBUG3: ', n, & + tb_obs(:,n) + if (crtm_cloud ) then + if (print_cld_debug) write(stdout,'(A,I8,*(2x,F10.4:))') 'PIXEL_DEBUG4: ', n, & + tb_xb_clr(:,n) + end if + + if (print_cld_debug) write(stdout,'(A,I8,8F12.4,2x,A)') 'PIXEL_DEBUG5: ', n, & + iv%instid(isens)%info%lat(1,n), iv%instid(isens)%info%lon(1,n), & + iv%instid(isens)%satzen(n), iv%instid(isens)%satazi(n), & + iv%instid(isens)%solzen(n), iv%instid(isens)%solazi(n), & + iv%instid(isens)%tropt(n), iv%instid(isens)%superob(superob_center,superob_center)%cld_qc(n)%terr_hgt, & + iv%instid(isens)%info%date_char(n) +!JJGDEBUG + + + ! Assume tb_xb_clr (central pixel) is applicable to all super-obbed pixels + if (tb_xb_clr(ch7,n) > 0.) then + rad_b_ch7 = plfk1(ch7) / & + ( exp( plfk2(ch7) / ( plbc1(ch7) + plbc2(ch7) * tb_xb_clr(ch7,n) ) ) - 1.0 ) + else + rad_b_ch7 = missing_r + end if + + if (tb_xb_clr(ch14,n) > 0.) then + rad_b_ch14 = plfk1(ch7) / & + ( exp( plfk2(ch7) / ( plbc1(ch7) + plbc2(ch7) * tb_xb_clr(ch14,n) ) ) - 1.0 ) + else + rad_b_ch14 = missing_r + end if + + if ( tb_xb_clr(ch14,n) > 0. ) then + rad_M14 = plfk1(ch14) / & + ( exp( plfk2(ch14) / (plbc1(ch14) + plbc2(ch14) * tb_xb_clr(ch14,n)) ) - 1.0 ) + else + rad_M14 = missing_r + end if + if ( iv%instid(isens)%tropt(n) > 0. ) then + rad_tropt = plfk1(ch14) / & + ( exp( plfk2(ch14) / (plbc1(ch14) + plbc2(ch14) * iv%instid(isens)%tropt(n)) ) - 1.0 ) + else + rad_tropt = missing_r + end if + + clddet_tests = 0 + do jsuper = 1, iv%instid(isens)%superob_width + do isuper = 1, iv%instid(isens)%superob_width + ! Use tb_obs for this particular super-ob pixel + + tb_obs => iv%instid(isens)%superob(isuper,jsuper)%tb_obs + + if (tb_obs(ch7,n) > 0.) then + rad_o_ch7 = plfk1(ch7) / & + ( exp( plfk2(ch7) / ( plbc1(ch7) + plbc2(ch7) * tb_obs(ch7,n) ) ) - 1.0 ) + else + rad_o_ch7 = missing_r + end if + if (tb_obs(ch14,n) > 0.) then + rad_o_ch14 = plfk1(ch7) / & + ( exp( plfk2(ch7) / ( plbc1(ch7) + plbc2(ch7) * tb_obs(ch14,n) ) ) - 1.0 ) + rad_O14 = plfk1(ch14) / & + ( exp( plfk2(ch14) / ( plbc1(ch14) + plbc2(ch14) * tb_obs(ch14,n) ) ) - 1.0 ) + else + rad_o_ch14 = missing_r + rad_O14 = missing_r + end if + + + ABICloudTestLoop: do itest = 1, num_clddet_tests + qual_clddet = .true. + offset_clddet = 0 + crit_clddet = missing_r + + select case (itest) + case (1) + !-------------------------------------------------------------------------- + ! 4.1 Relative Thermal Contrast Test (RTCT) + !-------------------------------------------------------------------------- + crit_clddet = iv%instid(isens)%superob(isuper,jsuper)%cld_qc(n)%RTCT + qual_clddet(3:4) = .false. + + case (2) + !-------------------------------------------------------------------------- + ! 4.2 Cloud check: step 1 + ! Emissivity at Tropopause Test (ETROP) + !-------------------------------------------------------------------------- + if ( all((/rad_O14,rad_M14,rad_tropt/) > 0.0) ) & + crit_clddet = (rad_O14 - rad_M14) / (rad_tropt - rad_M14) + + case (3) + !-------------------------------------------------------------------------- + ! 4.3 Cloud check: step 2 + ! Positive Fourteen Minus Fifteen Test (PFMFT) + !-------------------------------------------------------------------------- + ! See ABI Cloud Mask Description for qual_clddet + qual_clddet = & + tb_xb_clr(ch14,n) > 0.0 .and. & + tb_xb_clr(ch15,n) > 0.0 .and. & + (tb_xb_clr(ch14,n) >= tb_xb_clr(ch15,n)) + + if ( (tb_obs(ch14,n)) <= 310. .and. & + iv%instid(isens)%superob(isuper,jsuper)%cld_qc(n)%tb_stddev_3x3(ch14) >= 0.3 .and. & + tb_obs(ch14,n) > 0. .and. tb_obs(ch15,n) > 0. ) & + crit_clddet = ( tb_obs(ch14,n) - tb_obs(ch15,n) ) +! above using ob without VarBC +! ------------------------------- +! crit_clddet = (tb_inv(ch14,n) + tb_xb_clr(ch14,n) - & +! (tb_inv(ch15,n) + tb_xb_clr(ch15,n)) ) +! above using ob with VarBC (requires clear-sky tb_inv) +! ------------------------------- + + if ( crit_clddet > missing_r .and. & + (tb_obs(ch14,n)) > 270. .and. & + tb_xb_clr(ch14,n) > 270. ) & + crit_clddet = crit_clddet - & + (tb_xb_clr(ch14,n) - tb_xb_clr(ch15,n)) * & + (tb_obs(ch14,n) - 260.) / (tb_xb_clr(ch14,n) - 260.) +! above 1 line using ob without VarBC +! (tb_inv(ch14,n) + tb_xb_clr(ch14,n) - 260.)/ & +! (tb_xb_clr(ch14,n) - 260.) +! above 2 lines using ob with VarBC (requires clear-sky tb_inv) + + case (4) + !-------------------------------------------------------------------------- + ! 4.4 Negative Fourteen Minus Fifteen Test (NFMFT) + !-------------------------------------------------------------------------- + if (tb_obs(ch14,n) > 0. .and. tb_obs(ch15,n) > 0. .and. & + tb_xb_clr(ch14,n) > 0. .and. tb_xb_clr(ch15,n) > 0. ) & + crit_clddet = (tb_xb_clr(ch14,n) - tb_xb_clr(ch15,n) ) & + - (tb_obs(ch14,n) - tb_obs(ch15,n)) + + case (5) + !-------------------------------------------------------------------------- + ! 4.5 Relative Fourteen Minus Fifteen Test (RFMFT) + !-------------------------------------------------------------------------- + ! See ABI Cloud Mask Description for qual_clddet + if (tb_obs(ch14,n) > 0. .and. tb_obs(ch15,n) > 0. ) then + qual_clddet = ( tb_obs(ch14,n) - tb_obs(ch15,n) ) < 1.0 + qual_clddet(2) = qual_clddet(2) .and. tb_obs(ch14,n) <= 300. + qual_clddet(3:4) = .false. + + crit_clddet = iv%instid(isens)%superob(isuper,jsuper)%cld_qc(n)%RFMFT + end if + + case (6) + !-------------------------------------------------------------------------- + ! 4.6 Cirrus Water Vapor Test (CIRH2O) + !-------------------------------------------------------------------------- + ! See ABI Cloud Mask Description for qual_clddet + qual_clddet = & + iv%instid(isens)%superob(isuper,jsuper)%cld_qc(n)%terr_hgt <= 2000. & + .and. iv%instid(isens)%superob(isuper,jsuper)%cld_qc(n)%tb_stddev_3x3(ch10) > 0.5 & + .and. iv%instid(isens)%superob(isuper,jsuper)%cld_qc(n)%tb_stddev_3x3(ch14) > 0.5 + + crit_clddet = iv%instid(isens)%superob(isuper,jsuper)%cld_qc(n)%CIRH2O + + case (7) + !-------------------------------------------------------------------------- + ! 4.7 Modified 4um Emissivity Test (M-4EMISS) + !-------------------------------------------------------------------------- + ! Modify EMISS for sun glint area may be not work, because we are at north land + ! - compute relative azimuth + if ( all((/rad_o_ch7,rad_o_ch14,rad_b_ch7,rad_b_ch14/) > 0.0) ) & + crit_clddet = (rad_o_ch7/rad_o_ch14 - rad_b_ch7/rad_b_ch14) / & + (rad_b_ch7 / rad_b_ch14) + + if ( iv%instid(isens)%solzen(n) > 0. & + .and. iv%instid(isens)%solzen(n) < 90. ) then + Relaz = RELATIVE_AZIMUTH(iv%instid(isens)%solazi(n),iv%instid(isens)%satazi(n)) + + ! - compute glint angle + Glintzen = GLINT_ANGLE(iv%instid(isens)%solzen(n),iv%instid(isens)%satzen(n),Relaz ) + + if ( Glintzen < 40.0 .and. isflg==sea_flag) then + if (tb_xb_clr(ch7,n) > 0. .and. tb_obs(ch7,n) > 0.) then + crit_clddet = tb_xb_clr(ch7,n) - tb_obs(ch7,n) ! (B_ch7 - O_ch7) + else + crit_clddet = missing_r + endif + offset_clddet = 1 + end if + end if + + case (8) + !-------------------------------------------------------------------------- + ! 4.8 Uniform low stratus Test (ULST) + !-------------------------------------------------------------------------- +!JJG, AHI error: Changed this to solzen instead of solazi for night/day test + qual_clddet = iv%instid(isens)%solzen(n) >= 85.0 + if ( all((/rad_o_ch7,rad_o_ch14,rad_b_ch7,rad_b_ch14/) > 0.0) ) & + crit_clddet = rad_b_ch7/rad_b_ch14 - rad_o_ch7/rad_o_ch14 + + case (9) + !-------------------------------------------------------------------------- + ! 4.9 New Optically Thin Cloud Test (N-OTC) + !-------------------------------------------------------------------------- +!JJG, AHI error: Changed this to solzen instead of solazi for night/day test + if ( iv%instid(isens)%solzen(n) >= 85.0 ) & + offset_clddet = 1 ! night time + + if (tb_obs(ch7,n) > 0. .and. tb_obs(ch15,n) > 0.) & +! using ob without VarBC +! ------------------------------- + crit_clddet = tb_obs(ch7,n) - tb_obs(ch15,n) + +! using ob with VarBC (requires clear-sky tb_inv) +! ------------------------------- +! crit_clddet = tb_inv(ch7,n) + tb_xb_clr(ch7,n) - & +! (tb_inv(ch15,n) + tb_xb_clr(ch15,n)) + + case (10) + !-------------------------------------------------------------------------- + ! 4.10 Temporal Infrared Test (TEMPIR) + !-------------------------------------------------------------------------- + crit_clddet = iv%instid(isens)%superob(isuper,jsuper)%cld_qc(n)%TEMPIR + + case default + cycle ABICloudTestLoop + end select + +! call evaluate_clddet_test ( & +! isflg, isflgs_clddet, crit_clddet, eps_clddet(index_clddet(itest)+offset_clddet,:), qual_clddet, & +! iv%instid(isens)%info%lat(1,n), iv%instid(isens)%info%lon(1,n), & +! reject_clddet ) + + reject_clddet = crit_clddet > missing_r .and. & + any( isflg.eq.isflgs_clddet .and. & + crit_clddet > eps_clddet(index_clddet(itest)+offset_clddet,:) .and. & + qual_clddet ) + + if (reject_clddet) then + if (iv%instid(isens)%info%proc_domain(1,n)) then + nrej_clddet(:,itest) = nrej_clddet(:,itest) + 1 +!JJGDEBUG + if (print_cld_debug) write(stdout,"(A,F14.6,A,I4,2D12.4)") trim(crit_names_clddet(itest)), crit_clddet, " isflg", isflg, iv%instid(isens)%info%lat(1,n), iv%instid(isens)%info%lon(1,n) +!JJGDEBUG + end if + + clddet_tests(isuper, jsuper, itest) = 1 + end if + end do ABICloudTestLoop + end do ! isuper + end do ! jsuper + if ( iv%instid(isens)%superob_width > 1 ) then + iv%instid(isens)%cloud_frac(n) = & + real( count(sum(clddet_tests,3) > 0), 8 ) / real( iv%instid(isens)%superob_width**2, 8 ) + end if + + ! cloud_flag = - round (mean number of tests failed) + iv%instid(isens)%cloud_flag(:,n) = & + - NINT( real( sum(clddet_tests) , 8 ) / real( iv%instid(isens)%superob_width**2, 8 ) ) + + if (.not. crtm_cloud .and. & + iv%instid(isens)%cloud_flag(1,n) < 0) then + tb_qc = qc_bad + end if + +!JJGDEBUG + if (print_cld_debug) write(stdout,'(A,I8,*(2x,I1:))') 'PIXEL_DEBUG6: ', n, clddet_tests(superob_center,superob_center,:) +!JJGDEBUG + end if abi_clddet + + tb_obs => ob%instid(isens)%tb + + ! --------------------------- + ! 5.0 assigning obs errors + if (.not. crtm_cloud ) then + if (use_error_factor_rad) then + iv%instid(isens)%tb_error(:,n) = & + satinfo(isens)%error_std(:) * satinfo(isens)%error_factor(:) + else + iv%instid(isens)%tb_error(:,n) = satinfo(isens)%error_std(:) + end if + else !crtm_cloud + ! calculate cloud impacts + where ( tb_inv( :, n ) > missing_r & + .and. tb_obs( :, n ) > 0. & + .and. tb_xb( :, n ) > 0. & + .and. BTlim( : ) > 0. & !Harnisch + ) +! .and. tb_xb_clr( :, n ) > 0. & !Okamoto or Guerrette + +! using ob with VarBC (tb_inv + tb_xb) +! ------------------------------- +!! Harnisch et al. (2016) + cloud_mod(:,n) = max( 0., BTlim(:) - tb_xb(:,n) ) + cloud_obs(:,n) = max( 0., BTlim(:) - (tb_inv(:,n) + tb_xb(:,n)) ) + +!! Okamoto et al. (2013) +! cloud_mod(:,n) = abs( tb_xb(:,n) - tb_xb_clr(:,n) ) + & +! cloud_obs(:,n) = abs( (tb_inv(:,n) + tb_xb(:,n)) - tb_xb_clr(:,n) ) +!!! J. Guerrette +! cloud_mod(:,n) = max( 0., tb_xb_clr(:,n) - tb_xb(:,n) ) + & +! cloud_obs(:,n) = max( 0., tb_xb_clr(:,n) - (tb_inv(:,n) + tb_xb(:,n)) ) + endwhere +!JJGDEBUG + if (print_cld_debug) write(stdout,'(A,I8,*(2x,F16.8))') 'PIXEL_DEBUG93: ', n, & + 0.5 * ( cloud_mod(:,n) + cloud_obs(:,n) ) +!JJGDEBUG + + if (abi_use_symm_obs_err) then + ! symmetric error model + ! - Okamoto, McNally, & Bell (2013) + ! - Harnish, Weissmann, & Perianez (2016) + + cloud_mean = 0.5 * ( cloud_mod(:,n) + cloud_obs(:,n) ) + + do k = 1, nchan + if ( cloud_mean(k) > missing_r ) then + if ( cloud_mean(k) < camin ) then + iv%instid(isens)%tb_error(k,n) = satinfo(isens)%error_std(k) + else if ( cloud_mean(k) < satinfo(isens)%error_cld_x(k) ) then + iv%instid(isens)%tb_error(k,n) = satinfo(isens)%error_std(k) + & + ( satinfo(isens)%error_cld_y(k) - satinfo(isens)%error_std(k) ) * & + ( cloud_mean(k) - camin ) / ( satinfo(isens)%error_cld_x(k) - camin ) + else + iv%instid(isens)%tb_error(k,n) = satinfo(isens)%error_cld_y(k) + end if + else + iv%instid(isens)%tb_error(k,n) = missing_r + end if + end do ! nchan + else + iv%instid(isens)%tb_error(1:nchan,n) = satinfo(isens)%error_std(1:nchan) + end if + end if + + ! 5.1 check obs and background + !----------------------------------------------------------------- + do k = 1, nchan + if (tb_obs(k,n) < 0.0) then + tb_qc(k) = qc_bad + end if + if (tb_xb(k,n) < 0.0) then + tb_qc(k) = qc_bad + end if + end do ! nchan + + + ! 5.2 check innovation + !----------------------------------------------------------------- + ! absolute departure check + do k = 1, nchan + if (abs(tb_inv(k,n)) > inv_grosscheck) then + tb_qc(k) = qc_bad + if (iv%instid(isens)%info%proc_domain(1,n)) & + nrej_omb_abs(k) = nrej_omb_abs(k) + 1 + end if + end do ! nchan + + iv%instid(isens)%tb_qc(:,n) = tb_qc + + do k = 1, nchan + ! relative departure check + if (abs(tb_inv(k,n)) > 3.0 * iv%instid(isens)%tb_error(k,n)) then + iv%instid(isens)%tb_qc(k,n) = qc_bad + if (iv%instid(isens)%info%proc_domain(1,n)) & + nrej_omb_std(k) = nrej_omb_std(k) + 1 + end if + + ! final QC decsion + if (iv%instid(isens)%tb_qc(k,n) == qc_bad) then +! iv%instid(isens)%tb_error(k,n) = 500.0 + if (iv%instid(isens)%info%proc_domain(1,n)) & + nrej(k) = nrej(k) + 1 + else + if (iv%instid(isens)%info%proc_domain(1,n)) & + ngood(k) = ngood(k) + 1 + end if + end do ! nchan + end do ABIPixelQCLoop + + ! Do inter-processor communication to gather statistics. + call da_proc_sum_int (num_proc_domain) + call da_proc_sum_int (nrej_mixsurface) + call da_proc_sum_int (nrej_land) + call da_proc_sum_ints (nrej_eccloud) + + do itest = 1, num_clddet_tests + call da_proc_sum_ints (nrej_clddet(:,itest)) + end do + + call da_proc_sum_ints (nrej_omb_abs) + call da_proc_sum_ints (nrej_omb_std) + call da_proc_sum_ints (nrej_clw) + call da_proc_sum_ints (nrej) + call da_proc_sum_ints (ngood) + + if (rootproc) then + if (num_fgat_time > 1) then + write(filename,'(i2.2,a,i2.2)') it,'_qcstat_'//trim(iv%instid(isens)%rttovid_string)//'_',iv%time + else + write(filename,'(i2.2,a)') it,'_qcstat_'//trim(iv%instid(isens)%rttovid_string) + end if + + call da_get_unit(fgat_rad_unit) + open(fgat_rad_unit,file=trim(filename),form='formatted',iostat=ios) + if (ios /= 0) then + write(unit=message(1),fmt='(A,A)') 'error opening the output file ', filename + call da_error(__FILE__,__LINE__,message(1:1)) + end if + + write(fgat_rad_unit, fmt='(/a/)') ' Quality Control Statistics for '//iv%instid(isens)%rttovid_string + if(num_proc_domain > 0) write(fgat_rad_unit,'(a20,i7)') ' num_proc_domain = ', num_proc_domain + write(fgat_rad_unit,'(a20,i7)') ' nrej_mixsurface = ', nrej_mixsurface + write(fgat_rad_unit,'(a20,i7)') ' nrej_land = ', nrej_land + write(fgat_rad_unit,'(a20)') ' nrej_eccloud(:) = ' + write(fgat_rad_unit,'(10i7)') nrej_eccloud(:) + write(fgat_rad_unit,'(a20)') ' nrej_clw(:) = ' + write(fgat_rad_unit,'(10i7)') nrej_clw(:) + + do itest = 1, num_clddet_tests + write(fgat_rad_unit,'(3A)') ' nrej_',trim(crit_names_clddet(itest)),'(:) = ' + write(fgat_rad_unit,'(10i8)') nrej_clddet(:,itest) + end do + + write(fgat_rad_unit,'(a20)') ' nrej_omb_abs(:) = ' + write(fgat_rad_unit,'(10i7)') nrej_omb_abs(:) + write(fgat_rad_unit,'(a20)') ' nrej_omb_std(:) = ' + write(fgat_rad_unit,'(10i7)') nrej_omb_std(:) + write(fgat_rad_unit,'(a20)') ' nrej(:) = ' + write(fgat_rad_unit,'(10i7)') nrej(:) + write(fgat_rad_unit,'(a20)') ' ngood(:) = ' + write(fgat_rad_unit,'(10i7)') ngood(:) + + close(fgat_rad_unit) + call da_free_unit(fgat_rad_unit) + end if + + if (trace_use) call da_trace_exit("da_qc_goesabi") + +end subroutine da_qc_goesabi + diff --git a/var/da/da_radiance/da_qc_rad.inc b/var/da/da_radiance/da_qc_rad.inc index 6a418fbbb8..2d320227ab 100644 --- a/var/da/da_radiance/da_qc_rad.inc +++ b/var/da/da_radiance/da_qc_rad.inc @@ -14,7 +14,7 @@ subroutine da_qc_rad (it, ob, iv) integer :: i, nchan,p,j logical :: amsua, amsub, hirs, msu,airs, hsb, ssmis, mhs, iasi, seviri - logical :: mwts, mwhs, atms, amsr2, imager, ahi, mwhs2, gmi + logical :: mwts, mwhs, atms, amsr2, imager, ahi, mwhs2, gmi, abi integer, allocatable :: index(:) integer :: num_tovs_avg @@ -66,6 +66,7 @@ subroutine da_qc_rad (it, ob, iv) amsr2 = trim(rttov_inst_name(rtminit_sensor(i))) == 'amsr2' imager = trim(rttov_inst_name(rtminit_sensor(i))) == 'imager' ahi = trim(rttov_inst_name(rtminit_sensor(i))) == 'ahi' + abi = trim(rttov_inst_name(rtminit_sensor(i))) == 'abi' gmi = trim(rttov_inst_name(rtminit_sensor(i))) == 'gmi' if (hirs) then ! 1.0 QC for HIRS @@ -104,6 +105,8 @@ subroutine da_qc_rad (it, ob, iv) call da_qc_ahi(it,i,nchan,ob,iv) else if (imager) then call da_qc_goesimg(it,i,nchan,ob,iv) + else if (abi) then + call da_qc_goesabi(it,i,nchan,ob,iv) else if (gmi) then call da_qc_gmi(it,i,nchan,ob,iv) else diff --git a/var/da/da_radiance/da_radiance.f90 b/var/da/da_radiance/da_radiance.f90 index 167d0480b5..cb1aa20d6b 100644 --- a/var/da/da_radiance/da_radiance.f90 +++ b/var/da/da_radiance/da_radiance.f90 @@ -11,6 +11,9 @@ module da_radiance #if defined(RTTOV) || defined(CRTM) use module_domain, only : xb_type, domain +#ifdef DM_PARALLEL + use module_dm, only : ntasks_x, ntasks_y +#endif use module_radiance, only : satinfo, & i_kind,r_kind, r_double, & one, zero, three,deg2rad,rad2deg, & @@ -58,6 +61,8 @@ module da_radiance use_rad,crtm_cloud, DT_cloud_model, global, use_varbc, freeze_varbc, & airs_warmest_fov, time_slots, interp_option, ids, ide, jds, jde, & ips, ipe, jps, jpe, simulated_rad_ngrid, obs_qc_pointer, use_blacklist_rad, use_satcv, & + use_goesabiobs, abi_superob_halfwidth, & + var4d, var4d_bin, & use_goesimgobs, pi, earth_radius, satellite_height,use_clddet_zz, ahi_superob_halfwidth, ahi_apply_clrsky_bias #ifdef CRTM @@ -88,7 +93,7 @@ module da_radiance use da_statistics, only : da_stats_calculate use da_tools, only : da_residual, da_obs_sfc_correction, & da_llxy, da_llxy_new, da_togrid_new, da_get_julian_time, da_get_time_slots, & - da_xyll, map_info + da_xyll, map_info, da_llxy_1d use da_tracing, only : da_trace_entry, da_trace_exit, da_trace, & da_trace_int_sort use da_varbc, only : da_varbc_direct,da_varbc_coldstart,da_varbc_precond, & @@ -129,6 +134,11 @@ module da_radiance #include "da_read_obs_netcdf4ahi_geocat.inc" #include "da_read_obs_netcdf4ahi_jaxa.inc" #include "da_read_obs_ncgoesimg.inc" +#include "da_read_obs_ncgoesabi.inc" +#include "da_get_sat_angles.inc" +#include "da_get_sat_angles_1d.inc" +#include "da_get_solar_angles.inc" +#include "da_get_solar_angles_1d.inc" #include "da_read_obs_hdf5gmi.inc" #include "da_get_satzen.inc" #include "da_allocate_rad_iv.inc" diff --git a/var/da/da_radiance/da_radiance1.f90 b/var/da/da_radiance/da_radiance1.f90 index e4690c086b..d53688d6a5 100644 --- a/var/da/da_radiance/da_radiance1.f90 +++ b/var/da/da_radiance/da_radiance1.f90 @@ -9,9 +9,11 @@ module da_radiance1 #ifdef CRTM use module_radiance, only : CRTM_Planck_Radiance, CRTM_Planck_Temperature #endif + use module_radiance, only : & #ifdef RTTOV - use module_radiance, only : coefs + coefs, & #endif + deg2rad use da_control, only : trace_use,missing_r, rootproc, & stdout,myproc,qc_good,num_fgat_time,qc_bad, & @@ -22,12 +24,16 @@ module da_radiance1 use_pseudo_rad, pi, t_triple, crtm_cloud, DT_cloud_model,write_jacobian, & use_crtm_kmatrix,use_clddet, use_satcv, cv_size_domain, & cv_size_domain_js, calc_weightfunc, deg_to_rad, rad_to_deg,use_clddet_zz, & - ahi_superob_halfwidth, ahi_use_symm_obs_err + ahi_superob_halfwidth, abi_superob_halfwidth, ahi_use_symm_obs_err, abi_use_symm_obs_err use da_define_structures, only : info_type,model_loc_type,maxmin_type, & iv_type, y_type, jo_type,bad_data_type,bad_data_type,number_type, & be_type, clddet_geoir_type, superob_type use module_dm, only : wrf_dm_sum_real, wrf_dm_sum_integer - use da_par_util, only : da_proc_stats_combine +#ifdef DM_PARALLEL + use da_par_util, only : da_proc_stats_combine, true_mpi_real +#else + use da_par_util, only : da_proc_stats_combine +#endif use da_par_util1, only : da_proc_sum_int,da_proc_sum_ints use da_reporting, only : da_error, message use da_statistics, only : da_stats_calculate @@ -48,7 +54,7 @@ module da_radiance1 #endif implicit none - + type datalink_type type (info_type) :: info @@ -75,6 +81,7 @@ module da_radiance1 real, pointer :: tb_inv(:) real, pointer :: tb_qc(:) real, pointer :: tb_error(:) + real, pointer :: rad_obs(:) integer :: sensor_index type (datalink_type), pointer :: next ! pointer to next data end type datalink_type @@ -248,6 +255,7 @@ module da_radiance1 #include "da_qc_ahi.inc" #include "da_qc_gmi.inc" #include "da_qc_goesimg.inc" +#include "da_qc_goesabi.inc" #include "da_write_iv_rad_ascii.inc" #include "da_write_iv_rad_for_multi_inc.inc" #include "da_read_iv_rad_for_multi_inc.inc" diff --git a/var/da/da_radiance/da_radiance_init.inc b/var/da/da_radiance/da_radiance_init.inc index 3773b40122..63e471de9c 100644 --- a/var/da/da_radiance/da_radiance_init.inc +++ b/var/da/da_radiance/da_radiance_init.inc @@ -34,8 +34,9 @@ subroutine da_radiance_init(iv,ob) integer :: iunit character(len=filename_len) :: filename character(len=20) :: cdum + real :: error_cld_y, error_cld_x ! for ABI character(len=12) :: cdum12 - real :: error_cld + real :: error_cld ! for AMSR2 ! local variables for tuning error factor !---------------------------------------- @@ -152,6 +153,9 @@ subroutine da_radiance_init(iv,ob) else if ( trim( crtm_sensor_name(rtminit_sensor(n))) == 'imgr' ) then nchanl(n) = 4 nscan(n) = 60 + else if ( trim( crtm_sensor_name(rtminit_sensor(n))) == 'abi' ) then + nchanl(n) = 10 + nscan(n) = 22 else if ( trim( crtm_sensor_name(rtminit_sensor(n))) == 'gmi' ) then nchanl(n) = 13 nscan(n) = 221 @@ -204,6 +208,14 @@ subroutine da_radiance_init(iv,ob) allocate ( satinfo(n) % clearSkyBias(nchanl(n)) ) endif + ! Allocate additional fields for ABI + if ( index(iv%instid(n)%rttovid_string, 'abi') > 0 ) then + allocate ( satinfo(n) % error_cld_y(nchanl(n)) ) + allocate ( satinfo(n) % error_cld_x(nchanl(n)) ) + satinfo(n) % error_cld_y(:) = 500.0 !initialize + satinfo(n) % error_cld_x(:) = 5.0 !initialize + endif + read(iunit,*) do j = 1, nchanl(n) read(iunit,'(1x,5i5,2e18.10,a20)') & @@ -217,7 +229,7 @@ subroutine da_radiance_init(iv,ob) cdum !in the current radiance info files, the last column !can be either sensor_id_string or blank - if ( len_trim(cdum) > 0 .and. index(cdum,'-') == 0 ) then + if ( len_trim(cdum) > 0 .and. index(cdum,'-') == 0 ) then ! this is for AMSR2 ! read the line again to get error_cld when it is available backspace(iunit) read(iunit,'(1x,5i5,2e18.10,f10.5)') & @@ -228,10 +240,10 @@ subroutine da_radiance_init(iv,ob) idum, & satinfo(n)%error(j), & satinfo(n)%polar(j), & - error_cld - if ( error_cld > 0.0 ) then + error_cld + if ( error_cld > 0.0 ) then satinfo(n)%error_cld(j) = error_cld - end if + end if end if ! If AHI, read some extra things @@ -258,6 +270,30 @@ subroutine da_radiance_init(iv,ob) write(*,fmt='(i7,6x,4f9.3)') satinfo(n)%ichan(j), satinfo(n)%BTLim(j), satinfo(n)%ca1(j), satinfo(n)%ca2(j), satinfo(n)%clearSkyBias(j) endif + ! If ABI, read some extra things + ! Unfortunately, we need to read everything again... + if ( index(iv%instid(n)%rttovid_string, 'abi') > 0 ) then + backspace(iunit) + read(iunit,'(1x,5i5,2e18.10,2f10.5)') & + wmo_sensor_id, & + satinfo(n)%ichan(j), & + sensor_type, & + satinfo(n)%iuse(j) , & + idum, & + satinfo(n)%error(j), & + satinfo(n)%polar(j), & + error_cld_y, error_cld_x + if ( error_cld_y > 0.0 ) & + satinfo(n)%error_cld_y(j) = error_cld_y + if ( error_cld_x > 0.0 ) & + satinfo(n)%error_cld_x(j) = error_cld_x + if ( j == 1 ) then + write(*,*)'Reading extra data for ABI' + write(*,*)'Channel error_cld_y error_cld_x' + endif + write(*,fmt='(i7,6x,2f10.5)') satinfo(n)%ichan(j), satinfo(n)%error_cld_y(j), satinfo(n)%error_cld_x(j) + endif + iv%instid(n)%ichan(j) = satinfo(n)%ichan(j) ob%instid(n)%ichan(j) = satinfo(n)%ichan(j) end do diff --git a/var/da/da_radiance/da_read_obs_ncgoesabi.inc b/var/da/da_radiance/da_read_obs_ncgoesabi.inc new file mode 100644 index 0000000000..30ba8f994b --- /dev/null +++ b/var/da/da_radiance/da_read_obs_ncgoesabi.inc @@ -0,0 +1,2623 @@ +subroutine da_read_obs_ncgoesabi (iv, satellite_id) + + implicit none + +! 1.0 Read locs, parse, and select NC files: identify files for channels, views, times, overlap w/ patch/domain +!---------------------------------------------------------------------------------------------------------- +! 2.0 Read (BT) NC files: grab radiance data and convert to BT (K) +!---------------------------------------------------------------------------------------------------------- +! +! JJG: NEED TO ADD A MORE COMPLETE DESCRIPTION HERE +! + + !These libraries must be linked: netcdf, mpi + + !!These externally defined variables/routines are used herein: + ! cpp: DM_PARALLEL + ! PARALLELIZATION: ntasks_x, ntasks_y, num_procs, myproc, comm, ierr, true_mpi_real + ! RADIANCE OPERATOR: rtminit_nsensor, rtminit_platform, rtminit_sensor, rtminit_satid + ! THINNING: thinning_grid + ! GENERAL OBS: num_fgat_time, time_slots + ! WRFDA types: iv_type, datalink_type, info_type, model_loc_type + ! WRFDA subs: da_llxy, da_get_julian_time, + ! da_get_unit, da_free_unit, + ! da_get_sat_angles(_1d), da_get_solar_angles(_1d) + ! da_trace_entry, da_trace_exit, + ! precisions: r_double, i_kind + + type (iv_type),intent (inout) :: iv + integer, intent(in) :: satellite_id ! 16 or 17 + + type(datalink_type), pointer :: head, p, current, prev, p_fgat + type(info_type) :: info + type(model_loc_type) :: loc + integer(i_kind), allocatable :: ptotal(:) + integer(i_kind) :: nthinned + real(r_double) :: crit + integer(i_kind) :: iout, iobs, i_dummy(1) + logical :: outside, outside_all, iuse, first_chan + logical :: found, head_found + + !! ABI Fixed Grid Variables + integer :: ny_global, nx_global + integer :: yoff_fd, xoff_fd + ! For MPI parallelization + integer :: nbuf, nrad_local, nrad_mask, buf_i, buf_f + integer, allocatable :: nbufs(:), displs(:) + integer :: ny_local, nx_local + + !! Earth location info + real, allocatable :: yy_abi(:), xx_abi(:) + real, allocatable :: yy_1d(:), xx_1d(:) + real, allocatable :: iy_1d(:), ix_1d(:) + real, allocatable :: solzen_1d(:), solazi_1d(:) + + real(r_double) :: req, rpol, pph, nam +!!! real :: lat_sat, lon_sat ! Assume fixed values in da_get_sat_angles + real, allocatable, target :: buf_real(:,:) + integer, allocatable, target :: buf_int(:,:) + type(model_loc_type), allocatable, target :: buf_loc(:) + type(info_type), allocatable :: info_1d(:) + + + ! Masks for data reduction + logical :: earthmask, zenmask + logical, allocatable :: & + earthmask_1d(:) , & + zenmask_1d(:) , & + domainmask_1d(:) , & + patchmask_1d(:) , & + dummybool_2d(:,:) , & + allmask_p(:,:) , & + readmask_p(:,:) , & + thinmask(:,:) + + logical, allocatable :: view_mask(:,:,:,:,:) + + logical :: use_view_mask, best_view + + + ! Brightness Temperature (K) + real, allocatable :: bt_p(:,:,:), rad_p(:,:,:), terrain_hgt(:,:) + real :: bc1, bc2, fk1, fk2 + + !! Iterates + integer :: ichan, ifile, iview, ifgat, ipass, ioff, & + jchan, jfile, jview, icount, io_stat, & + n, i, j, iy, ix, jy, jx, iyl, ixl, iyfd, ixfd, iproc, subgrid, & + isup, jsup, ixsup, iysup + INTEGER :: cstat, estat + CHARACTER(LEN=100) :: cmsg + logical :: exists + + !! Satellite variables + integer(i_kind),parameter :: nchan = 10 + integer(i_kind),parameter :: nscan = 22 + integer, parameter :: platform_id = 4 ! GOES series + integer, parameter :: sensor_id = 44 ! ABI + integer, parameter :: channel_list(nchan) = (/7,8,9,10,11,12,13,14,15,16/) !List of all available channels +! integer, parameter :: channel_index(channel_list(1):channel_list(nchan)) = (/1,2,3,4,5,6,7,8,9,10/) !List of all available channels + + integer, parameter :: nviews = 4 + integer(i_kind) :: inst + character(len=14), parameter :: INST_PREFIX = 'OR_ABI-L1b-Rad' + + !! File reading variables + character(len=1000) :: fname, command + character(len=50) :: list_file + integer :: file_unit + + type date_type + integer :: yr, mt, dy, hr, mn, sc, jdy + real(r_double) :: obs_time + end type date_type + +! ! Linked list type for radiance location information +! type viewnode +! real :: lat, lon, satzen, satazi +! integer :: iy, ix +! type(model_loc_type) :: loc +! type(viewnode), pointer :: next +! integer :: i +! end type viewnode + + type field_r + real, pointer :: local(:) + real, pointer :: domain(:) + real, pointer :: patch(:) + end type field_r + type field_i + integer, pointer :: local(:) + integer, pointer :: domain(:) + integer, pointer :: patch(:) + end type field_i + type field_loc + type(model_loc_type), pointer :: local(:) + type(model_loc_type), pointer :: domain(:) + type(model_loc_type), pointer :: patch(:) + end type field_loc + + type viewinfo + logical :: select + integer :: nfiles + character(len=1000) :: fpath + character(len=200), allocatable :: filename(:) + integer, allocatable :: filechan(:) + type(date_type), allocatable :: filedate(:) + logical, allocatable :: file_fgat_match(:,:) + real*8, allocatable :: fgat_time_abs_diff(:,:) ! seconds + real*8, allocatable :: min_time_diff(:,:) ! seconds + integer, allocatable :: nfiles_used(:) + logical :: meta_initialized = .false. + logical :: grid_initialized = .false. + integer :: ny_global, nx_global, yoff_fd, xoff_fd + integer :: ys_local, xs_local + integer :: ye_local, xe_local + integer, allocatable :: ny_grid(:), nx_grid(:) + integer, allocatable :: ys_grid(:), xs_grid(:) + integer :: ys_p, xs_p + integer :: ye_p, xe_p + integer :: ys_p_fd, xs_p_fd + integer :: ye_p_fd, xe_p_fd + integer :: nrad_on_patch, nrad_on_domain + integer :: nrad_on_patch_cldqc, nrad_on_domain_cldqc + logical, allocatable :: patchmask(:,:,:) +! type(viewnode), pointer :: head +! type(viewnode), pointer :: current + + type(field_r) :: lat_1d, lon_1d, satzen_1d, satazi_1d + type(field_i) :: iy_1d, ix_1d + type(field_loc) :: loc_1d + + character(len=2) :: name_short + character(len=10) :: name + logical :: moving + end type viewinfo + + type(viewinfo), target, allocatable :: view_att(:) + type(viewinfo), pointer :: this_view + + integer :: first_file, tot_files_used, npass + integer :: ncid, varid + + !! WRFDA channel and satellite_id select + !! These should be inputs to the subroutine or global variables in WRFDA + !Could populate using .info file. Would reduce number of files to read... +! integer, dimension(10) :: channel_select = (/7, 8, 9, 10, 11, 12, 13, 14, 15, 16/) + + ! Global WRFDA obs timing info + character(len=19) :: fgat_times_c(num_fgat_time) + real(r_double) :: fgat_times_r(num_fgat_time) + + ! Local Obs date/time variables + real(r_double) :: obs_time + integer(i_kind) :: yr, mt, dy, hr, mn, sc, jdy + real(r_double) :: timbdy(2) + + ! Other work variables + real(r_double) :: dlon_earth,dlat_earth,dlon_earth_deg,dlat_earth_deg + real(r_double) :: ngoes + integer(i_kind) :: num_goesabi_local, num_goesabi_global, & + num_goesabi_used, num_goesabi_used_fgat(num_fgat_time), & + num_goesabi_used_tmp, num_goesabi_thinned + integer(i_kind) :: itx, itt + real, allocatable :: in(:), out(:) + + !Cloud QC variables + integer :: tbuf, nkeep, ikeep + integer :: abi_halo_width ! Must be ≥ 0 + integer :: superob_width + real :: mu10, mu14, sigma10, sigma14, pearson, temp_max + real :: mu, sigma + real, allocatable :: tb_temp(:,:) + logical :: cldqc + character(18) :: terr_fname + + integer :: TEMPIR_ifile + real :: TEMPIR_min_time_diff, TEMPIR_time_abs_diff + real, parameter :: TEMPIR_delay_minutes = 15.0 + + if (trace_use) call da_trace_entry("da_read_obs_ncgoesabi") + +! determine if satellite_id is supported +!----------------------------------------------------- + if(satellite_id .ne. 16 .and. & + satellite_id .ne. 17) then + write(unit=stdout,fmt='(A,I2.2,A)') 'goes satellite ', satellite_id, ' is not supported for abi instrument' + return + endif + + write(terr_fname,'(A,I2.2,A)') 'OR_ABI-TERR_G',satellite_id,'.nc' + +! determine if sensor triplet is in the sensor list +!----------------------------------------------------- + inst = 0 + do ngoes = 1, rtminit_nsensor + if (platform_id == rtminit_platform(ngoes) & + .and. sensor_id == rtminit_sensor(ngoes) & + .and. satellite_id == rtminit_satid(ngoes)) then + inst = ngoes + else + cycle + end if + end do + if (inst == 0) then + write(unit=message(1),fmt='(A,I2.2,A)') " goes-",satellite_id,"-abi is not in sensor list" + call da_warning(__FILE__,__LINE__, message(1:1)) + return + end if + + allocate(ptotal(0:num_fgat_time)) + ptotal(0:num_fgat_time) = 0 + iobs = 0 ! for thinning, argument is inout + + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !! Initialize ABI L1B reading + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + do ifgat=1,num_fgat_time + if (num_fgat_time.eq.1 .or. (ifgat.gt.1 .and. ifgat.lt.num_fgat_time)) then + fgat_times_r(ifgat) = & + (time_slots(ifgat) + time_slots(ifgat-1)) / 2.D0 !minutes + else if (ifgat .eq. 1) then !First time slot is dt/2 (da_get_time_slots) + fgat_times_r(ifgat) = & + time_slots(ifgat-1) !minutes + else !Last time slot is dt/2 (da_get_time_slots) + fgat_times_r(ifgat) = & + time_slots(ifgat) !minutes + end if + + call da_get_cal_time(fgat_times_r(ifgat),yr,mt,dy,hr,mn,sc) + fgat_times_r(ifgat) = fgat_times_r(ifgat) * 60.D0 !seconds + + write(unit=fgat_times_c(ifgat), & + fmt='(I4.4,A,I2.2,A,I2.2,A,I2.2,A,I2.2,A,I2.2)') & + yr, '-', mt, '-', dy, '_', hr, ':', mn, ':', sc + end do + + allocate(view_att(nviews)) + ! (default) All views are used (algorithm figures out which views have files present) + ! Could set this according to namelist entries + view_att(:) % select = .true. + view_att(1) % name_short = 'F' + view_att(2) % name_short = 'C' + view_att(3) % name_short = 'M1' + view_att(4) % name_short = 'M2' + + view_att(1) % name = 'Full Disk' + view_att(2) % name = 'CONUS' + view_att(3) % name = 'MESO1' + view_att(4) % name = 'MESO2' + + write(view_att(1) % fpath,'(A,I2.2,A)') "./goes-",satellite_id,"-fdisk*/" + write(view_att(2) % fpath,'(A,I2.2,A)') "./goes-",satellite_id,"-conus*/" + write(view_att(3) % fpath,'(A,I2.2,A)') "./goes-",satellite_id,"-meso*/" + write(view_att(4) % fpath,'(A,I2.2,A)') "./goes-",satellite_id,"-meso*/" + + ! (default) Full Disk and CONUS are fixed while MESO 1 & 2 can move within an assimilation window + view_att(1) % moving = .false. + view_att(2) % moving = .false. + view_att(3) % moving = .true. + view_att(4) % moving = .true. + +! ! Full Disk, CONUS, and MESO 1 & 2 are fixed within an assimilation window (e.g., 3D-Var) +! view_att(1) % moving = .false. +! view_att(2) % moving = .false. +! view_att(3) % moving = .false. +! view_att(4) % moving = .false. + + !! Initialize local obs structures + allocate (head) + nullify (head % next ) + p => head + + num_goesabi_local = 0 + num_goesabi_global = 0 + num_goesabi_used_fgat = 0 + num_goesabi_thinned = 0 + + abi_halo_width = abi_superob_halfwidth + if ( use_clddet_zz ) then + abi_halo_width = abi_halo_width + 10 + end if + + superob_width = 2*abi_superob_halfwidth+1 + + tot_files_used = 0 + use_view_mask = .false. + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !! Collect files available for all views + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + PrepViews: do iview = 1, nviews + this_view => view_att(iview) + + if ( .not.this_view % select ) cycle PrepViews + + ! Query fpath for files that match L1B naming conventions for this_view and satellite_id + fname = trim(INST_PREFIX)//trim(this_view % name_short) + write(list_file,'(A,I2.2,2A)') & + 'file_list_GOES-',satellite_id,'-ABI_',trim(this_view % name_short) + + call da_get_unit(file_unit) + + if (rootproc) then + inquire(file=trim(list_file), exist=exists) + if ( .not.exists ) then + ! Create list_file containing all files for this_view + write(unit=stdout,fmt='(5A)') 'Searching for GOES ', trim(this_view % name) ,' files in ', trim(this_view % fpath),'...' + + write(command,fmt='(5A,I2.2,2A)')& + "find ",trim(this_view % fpath), & + " \( -type l -o -type f \) -name '",trim(fname), & + "*G",satellite_id, & + "*' > ",trim(list_file) +! "*' -printf '%P\n' > ",trim(list_file) + + write(stdout,fmt='(A)') 'WARNING find requires substantial memory. It is recommended to issue' + write(stdout,fmt='(A)') 'WARNING the following from the command line before running WRFDA:' + write(stdout,fmt='(A)') adjustl(trim(command)) + cmsg = "" + call execute_command_line ( adjustl(trim(command)), & + WAIT=.true., EXITSTAT=estat, CMDSTAT=cstat, CMDMSG=cmsg ) + write(stdout,*) 'estat: ', estat + write(stdout,*) 'cstat: ', cstat + write(stdout,*) 'cmsg: ', cmsg + end if + write(unit=stdout,fmt='(5A)') 'Using GOES ', trim(this_view % name) ,' files listed in ', trim(list_file) + + icount = 0 + io_stat = -1 + do while (io_stat .ne. 0) + open(unit=file_unit,file=trim(list_file), iostat = io_stat) + icount = icount + 1 + if (icount .gt. 10000) exit + end do + + this_view % nfiles = 0 + do + read(file_unit, fmt=*, iostat = io_stat) + if ( io_stat .ne. 0 ) exit + this_view % nfiles = this_view % nfiles + 1 + end do + close(file_unit) + + i_dummy = this_view % nfiles + end if +#ifdef DM_PARALLEL + call mpi_barrier(comm, ierr) + call mpi_bcast ( i_dummy(1), 1, mpi_integer, root, comm, ierr ) + this_view % nfiles = i_dummy(1) +#endif + if (this_view % nfiles .lt. 1) then + this_view % select = .false. + cycle PrepViews + end if + + allocate(this_view % filename(this_view % nfiles)) + + ! Read the file names for this view + open(unit=file_unit,file=trim(list_file)) + read(file_unit, fmt='(A)') (this_view % filename(ifile), ifile=1,this_view % nfiles) + close(file_unit) + + call da_free_unit(file_unit) + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !! Allocate/init components for this_view + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + allocate(this_view % filechan(this_view % nfiles)) + allocate(this_view % filedate(this_view % nfiles)) + allocate(this_view % file_fgat_match(this_view % nfiles,num_fgat_time)) + allocate(this_view % fgat_time_abs_diff(this_view % nfiles,num_fgat_time)) + allocate(this_view % min_time_diff(nchan,num_fgat_time)) + allocate(this_view % nfiles_used(num_fgat_time)) + + this_view % file_fgat_match = .false. + do ifgat=1,num_fgat_time + this_view % fgat_time_abs_diff(:,ifgat) = & + abs(time_slots(ifgat) - time_slots(ifgat-1)) * 60.D0 !seconds + + this_view % min_time_diff(:,ifgat) = & + abs(time_slots(ifgat) - time_slots(ifgat-1)) * 60.D0 / 2.D0 !seconds + end do + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !! Determine which of the files will be used based on user-definitions: + !! + fgat window length + !! + channels used + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + do ifile = 1, this_view % nfiles + + !Grab the filename (without path) using INST_PREFIX + fname = trim(this_view % filename(ifile)) + ioff = index(fname, trim(INST_PREFIX)) +!! this_view % filepath(ifile) = fname(1:ioff-1) + fname = trim(fname(ioff:len(adjustl(trim(fname))))) +!! this_view % filename(ifile) = trim(fname) + + ioff = 0 + if (iview.eq.3 .or. iview.eq.4) ioff=1 + ioff = ioff+19 + read(fname(1+ioff:2+ioff),fmt='(I2.2)') this_view % filechan(ifile) + +!!! !! The channel could instead be read from band_id in each file, but +!!! !! opening/closing files for all channels is time consuming +!!! ierr=nf_open(trim(this_view % fpath)//trim(fname),nf_nowrite,ncid) +!!! ierr=nf_inq_varid(ncid,'band_id',varid) +!!! ierr=nf_get_var_int(ncid,varid,this_view % filechan(ifile)) +!!! ierr=nf_close(ncid) + + ! Check if channel is selected +! if ( .not.any(this_view % filechan(ifile) .eq. channel_select) .or. & + if ( .not.any(this_view % filechan(ifile) .eq. channel_list) ) then +!!! ierr=nf_close(ncid) + cycle + end if + + !! Determine central date of this file for obs binning + !obs START time + ioff = ioff + 8 + read(fname(1+ioff:4+ioff),fmt='(I4.4)') yr + read(fname(5+ioff:7+ioff),fmt='(I3.3)') jdy + read(fname(8+ioff:9+ioff),fmt='(I2.2)') hr + read(fname(10+ioff:11+ioff),fmt='(I2.2)') mn + read(fname(12+ioff:13+ioff),fmt='(I2.2)') sc + obs_time = real(sc,8)/60.D0 / 2.D0 + + call jday2cal(jdy, yr, mt, dy) + call da_get_julian_time(yr,mt,dy,hr,mn,timbdy(1)) + + this_view % filedate(ifile) % jdy = jdy + + !obs END time + ioff = ioff + 16 + read(fname(1+ioff:4+ioff),fmt='(I4.4)') yr + read(fname(5+ioff:7+ioff),fmt='(I3.3)') jdy + read(fname(8+ioff:9+ioff),fmt='(I2.2)') hr + read(fname(10+ioff:11+ioff),fmt='(I2.2)') mn + read(fname(12+ioff:13+ioff),fmt='(I2.2)') sc + obs_time = obs_time + real(sc,8)/60.D0 / 2.D0 + + call jday2cal(jdy, yr, mt, dy) + call da_get_julian_time(yr,mt,dy,hr,mn,timbdy(2)) + + obs_time = obs_time + (timbdy(1) + timbdy(2)) / 2.D0 + +!! The time it takes to read time_bounds from each file is not insignificant. Above method is much faster. +! !! Determine central date of this file for obs binning +!!! ierr=nf_open(trim(this_view % fpath)//trim(fname),nf_nowrite,ncid) +!!! ierr=nf_inq_varid(ncid,'time_bounds',varid) +!!! ierr=nf_get_var_double(ncid,varid,timbdy) +!!! ierr=nf_close(ncid) +!!! j2000=(timbdy(1) + timbdy(2)) / 2.D0 /86400.D0 + + call da_get_cal_time(obs_time,yr,mt,dy,hr,mn,sc) + obs_time = obs_time * 60.D0 + + this_view % filedate(ifile) % yr = yr + this_view % filedate(ifile) % mt = mt + this_view % filedate(ifile) % dy = dy + this_view % filedate(ifile) % hr = hr + this_view % filedate(ifile) % mn = mn + this_view % filedate(ifile) % sc = sc + this_view % filedate(ifile) % obs_time = obs_time + + +!JJG: Note that this test being limited by time_slots prevents the use of data before/after the first/last time of the window even if the observations outside the window were recorded at times nearer to those bounds than data contained within the window. + if ( obs_time < time_slots(0) * 60.D0 .or. & + obs_time >= time_slots(num_fgat_time) * 60.D0 ) then + cycle + end if + + do ifgat=1,num_fgat_time + this_view % file_fgat_match(ifile,ifgat) = & + ( obs_time >= time_slots(ifgat-1) * 60.D0 .and. & + obs_time < time_slots(ifgat) * 60.D0 ) + if (this_view % file_fgat_match(ifile,ifgat)) exit + end do + + this_view % fgat_time_abs_diff(ifile,ifgat) = & + abs( obs_time - fgat_times_r(ifgat) ) + + call get_ichan(this_view % filechan(ifile), channel_list, nchan, ichan) + if ( this_view % fgat_time_abs_diff(ifile, ifgat) .ge. & + this_view % min_time_diff(ichan, ifgat) ) then + this_view % file_fgat_match(ifile,ifgat) = .false. + else + this_view % min_time_diff(ichan, ifgat) = this_view % fgat_time_abs_diff(ifile, ifgat) + end if + + if (count(this_view % file_fgat_match(ifile,:)) .gt. 1) then + print*, 'WARNING: More than one bin was selected for ',trim(fname) + print*, 'num_bin_per_file = ',count(this_view % file_fgat_match(ifile,:)) + print*, 'obs_time = ',obs_time + print*, 'Ignoring this file for reading.' + this_view % file_fgat_match(ifile,:) = .false. + cycle + end if + end do + + do ifgat = 1, num_fgat_time + ! Select a single file for this view, channel, and fgat using min_time_diff + if ( count(this_view % file_fgat_match(:, ifgat)).gt.1 ) then + do ifile = 1, this_view % nfiles + if ( .not. this_view % file_fgat_match(ifile,ifgat) ) cycle + call get_ichan(this_view % filechan(ifile), channel_list, nchan, ichan) + if ( this_view % fgat_time_abs_diff(ifile, ifgat) .gt. & + this_view % min_time_diff(ichan, ifgat) ) then + this_view % file_fgat_match(ifile,ifgat) = .false. + end if + end do + end if + end do + end do PrepViews + + !! If Full Disk is selected, take 2 passes over the data: + !! + 1st pass: (A) Determine portions of each view corresponding to this patch + !! for each fgat and each channel across observed domain + !! (B) Eliminate portions of broader views (Full Disk and CONUS) that + !! can be replaced by narrower views (CONUS and MESO) with times + !! closer to fgat time + !! + 2nd pass: read radiance values, convert to BT, calculate quantities for online cloud detection QC + !! + !! Otherwise only take one pass, and duplicated data cannot be removed from CONUS/MESO1/MESO2 + + npass = 1 + if (count(view_att(:) % select).gt.1 .and. view_att(1) % select) npass = 2 + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !! Process data for views w/ nfiles > 1 + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + do ipass = 1, npass + write(unit=stdout,fmt=*) ' ' + write(unit=stdout,fmt=*) ' ' + write(unit=stdout,fmt='(A,I0,A,I2.2,A)') & + 'Starting pass ',ipass,& + ' of GOES-',satellite_id,' ABI data processing' + + !! Loop over the available views for this instrument (ABI) + do iview = 1, nviews + this_view => view_att(iview) + + if ( .not.this_view % select ) cycle + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !! Access netcdf channel/band files across all fgat windows + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + this_view % nfiles_used = 0 + + fgat_loop: do ifgat = 1, num_fgat_time + if (count(this_view % file_fgat_match(:, ifgat)) .lt. 1) then + cycle fgat_loop + end if + + first_file = 0 + do ifile = 1, this_view % nfiles + if ( .not. this_view % file_fgat_match(ifile,ifgat) ) cycle + first_file = ifile + exit + end do + if (first_file .eq. 0) cycle fgat_loop + + if ( sum(this_view % nfiles_used(:)).eq.0) & + write(unit=stdout,fmt='(2A)') & + 'Processing data for view: ', trim(this_view % name) + write(unit=stdout,fmt='(2A)') & + ' fgat time: ',fgat_times_c(ifgat) + + yr = this_view % filedate(first_file) % yr + mt = this_view % filedate(first_file) % mt + dy = this_view % filedate(first_file) % dy + hr = this_view % filedate(first_file) % hr + mn = this_view % filedate(first_file) % mn + sc = this_view % filedate(first_file) % sc + write(unit=stdout, & + fmt='(A,I4.4,A,I2.2,A,I2.2,A,I2.2,A,I2.2,A,I2.2)') & + ' data time: ',yr, '-', mt, '-', dy, '_', hr, ':', mn, ':', sc + + fname = trim(this_view % filename(first_file)) + + if ( .not.this_view % meta_initialized ) then + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !! Get ABI metadata (first pass for FD, CONUS, MESO) + ! Only ny_global and nx_global need to be read for all views, but this is a cheap subroutine + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + write(unit=stdout,fmt='(A)') & + ' Reading abi metadata...' + + this_view % meta_initialized = .true. + + call get_abil1b_metadata( & + fname, this_view % ny_global, this_view % nx_global, & + req, rpol, pph, nam)! , lat_sat, lon_sat ) + +#ifdef DM_PARALLEL + ! Split the global ABI grid for this view into local segments + allocate ( this_view % ny_grid ( num_procs ) ) + allocate ( this_view % nx_grid ( num_procs ) ) + allocate ( this_view % ys_grid ( num_procs ) ) + allocate ( this_view % xs_grid ( num_procs ) ) + + call split_grid( this_view % ny_global, this_view % nx_global , & + this_view % ny_grid, this_view % nx_grid , & + this_view % ys_grid, this_view % xs_grid ) +#else + ! When mpi parallelism is not available, assign global values to local variables + this_view % ny_grid = this_view % ny_global + this_view % nx_grid = this_view % nx_global + this_view % ys_grid = 1 + this_view % xs_grid = 1 +#endif + end if + + ! Recall global dims for this_view + ny_global = this_view % ny_global + nx_global = this_view % nx_global + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !! Generate grid locations if + !! + CONUS or FD and first matching fgat + !! + MESO and any fgat (extent changes in time) + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + DoGridGen: if ( this_view % moving .or. .not.this_view % grid_initialized ) then + + ! Read grid from file, convert to lat, lon, satzen, satazi + write(unit=stdout,fmt='(2A)') & + ' Establishing abi grid info...' + + this_view % grid_initialized = .true. + + !======================================================== + ! Establish GOES metadata for this view and ifgat + ! (constant acros fgat's, except for this_view % moving) + !======================================================== + allocate( yy_abi (ny_global) ) + allocate( xx_abi (nx_global) ) + call get_abil1b_grid1( fname, & + ny_global, nx_global, & + yy_abi, xx_abi, & + this_view % yoff_fd, this_view % xoff_fd ) + + if ( iview.eq.1 ) then + yoff_fd = this_view % yoff_fd + xoff_fd = this_view % xoff_fd + this_view % yoff_fd = 1 + this_view % xoff_fd = 1 + else + this_view % yoff_fd = this_view % yoff_fd - yoff_fd + 1 + this_view % xoff_fd = this_view % xoff_fd - xoff_fd + 1 + end if + + !=========================================================== + ! Create a local array subset of observation location + ! quantities across processors. + !=========================================================== + nrad_local = ny_global * nx_global / (num_procs-1) + allocate( yy_1d (nrad_local) ) + allocate( xx_1d (nrad_local) ) + allocate( iy_1d (nrad_local) ) + allocate( ix_1d (nrad_local) ) + + n = 0 ; icount = 0 + +!JJG: Not convinced that these subgrids are needed. Might be able to loop over global X/Y instead. This solution may be overly complex. mod test for load balancing is still needed! + ! This loop over subgrids and the selective logic + ! below for myproc balances the processor loads + ! when some imager pixels are off-earth or outside + ! zenith-angle limits (Full Disk and CONUS) + do subgrid = 1, num_procs + ! Recall local dims for this_view + ny_local = this_view % ny_grid(subgrid) + nx_local = this_view % nx_grid(subgrid) + this_view % ys_local = this_view % ys_grid(subgrid) + this_view % xs_local = this_view % xs_grid(subgrid) + + do ixl = 1, nx_local + do iyl = 1, ny_local + iy = iyl + this_view % ys_local - 1 + ix = ixl + this_view % xs_local - 1 + if ( mod( iy-abi_superob_halfwidth-1, superob_width ) == 0 .and. & + mod( ix-abi_superob_halfwidth-1, superob_width ) == 0 ) then + !This mod test produces balanced loads between processors + if ( mod( n, num_procs ) .eq. myproc ) then + icount = icount + 1 + + yy_1d ( icount ) = yy_abi( iy ) + xx_1d ( icount ) = xx_abi( ix ) + iy_1d ( icount ) = iy + ix_1d ( icount ) = ix + end if + n = n + 1 + end if + end do + end do + end do + +! !This may work as a simplified replacement for the code above, not sure if loads will be balanced +! do ix = 1, nx_global +! do iy = 1, ny_global +! !This mod test produces balanced loads between processors +! if ( mod( n, num_procs ) .eq. myproc ) then +! icount = icount + 1 +! yy_1d ( icount ) = yy_abi( iy ) +! xx_1d ( icount ) = xx_abi( ix ) +! iy_1d ( icount ) = iy +! ix_1d ( icount ) = ix +! end if +! n = n + 1 +! end do +! end do + + nrad_local = icount + + deallocate( yy_abi, xx_abi ) + + allocate( earthmask_1d (1:nrad_local) ) + allocate( zenmask_1d (1:nrad_local) ) + allocate( this_view % lat_1d % local (1:nrad_local) ) + allocate( this_view % lon_1d % local (1:nrad_local) ) + allocate( this_view % satzen_1d % local (1:nrad_local) ) + allocate( this_view % satazi_1d % local (1:nrad_local) ) + allocate( this_view % iy_1d % local (1:nrad_local) ) + allocate( this_view % ix_1d % local (1:nrad_local) ) + + ! Assign values for iy, ix, lat, lon, satzen, satazi + this_view % iy_1d % local = iy_1d (1:nrad_local) + this_view % ix_1d % local = ix_1d (1:nrad_local) + deallocate( iy_1d ) + deallocate( ix_1d ) + + write(unit=stdout,fmt='(3A,I0)') & + ' ',trim(this_view % name),' locations processed on this core: ', nrad_local + + if (nrad_local .gt. 0) & + call get_abil1b_grid2_1d( yy_1d(1:nrad_local), xx_1d(1:nrad_local), & + req, rpol, pph, nam, satellite_id, & + this_view % lat_1d % local, & + this_view % lon_1d % local, & + this_view % satzen_1d % local, & + this_view % satazi_1d % local, & + earthmask_1d, zenmask_1d ) + + ! Reduce values for iy, ix, lat, lon, satzen, satazi + ! using earth and zenith masks + nrad_mask = count ( earthmask_1d .and. zenmask_1d ) + this_view % lat_1d % local(1:nrad_mask) = & + pack(this_view % lat_1d % local , earthmask_1d .and. zenmask_1d ) + this_view % lon_1d % local(1:nrad_mask) = & + pack(this_view % lon_1d % local , earthmask_1d .and. zenmask_1d ) + this_view % satzen_1d % local(1:nrad_mask) = & + pack(this_view % satzen_1d % local , earthmask_1d .and. zenmask_1d ) + this_view % satazi_1d % local(1:nrad_mask) = & + pack(this_view % satazi_1d % local , earthmask_1d .and. zenmask_1d ) + this_view % iy_1d % local(1:nrad_mask) = & + pack(this_view % iy_1d % local , earthmask_1d .and. zenmask_1d ) + this_view % ix_1d % local(1:nrad_mask) = & + pack(this_view % ix_1d % local , earthmask_1d .and. zenmask_1d ) + + nrad_local = nrad_mask + + deallocate( earthmask_1d ) + deallocate( zenmask_1d ) + deallocate( yy_1d, xx_1d ) + + ! Populate loc x, y and determine in/outside domain + allocate ( this_view % loc_1d % local (nrad_local) ) + allocate ( domainmask_1d (nrad_local) ) + allocate ( dummybool_2d (nrad_local,2) ) + allocate ( info_1d (nrad_local) ) + info_1d (:) % lat = this_view % lat_1d % local ( 1:nrad_local ) + info_1d (:) % lon = this_view % lon_1d % local ( 1:nrad_local ) + call da_llxy_1d ( info_1d, this_view % loc_1d % local(:), & + dummybool_2d(:,1), dummybool_2d(:,2) ) + domainmask_1d = .not.dummybool_2d(:,2) + deallocate( dummybool_2d ) + deallocate( info_1d ) + nrad_mask = count( domainmask_1d ) + +#ifdef DM_PARALLEL + call mpi_barrier(comm, ierr) +#endif + ! COMMUNICATE 1D FIELDS FROM REMOTE PROCS TO LOCAL BUFFER + ! Note: these comms are a minor bottleneck, which will be + ! more noticeable for 4D-Var when MESO1/2 is processed + ! at multiple fgat's + ! Potential Solutions + ! SOLUTION 1: mpi_allgatherv (let's mpi figure out the most efficient way to distribute the data to all processes) + ! SOLUTION 2: round-robin mpi_bcast (may be less resource intensive with smaller communication chunks) + +! ! BEGIN SOLUTION 1 +!! !PACK UP DOMAIN DATA FROM THIS PROCESSOR +!! this_view % lat_1d % local (1:nrad_mask) = & +!! pack(this_view % lat_1d % local (1:nrad_local), domainmask_1d ) +!! this_view % lon_1d % local (1:nrad_mask) = & +!! pack(this_view % lon_1d % local (1:nrad_local), domainmask_1d ) +!! this_view % satzen_1d % local (1:nrad_mask) = & +!! pack(this_view % satzen_1d % local (1:nrad_local), domainmask_1d ) +!! this_view % satazi_1d % local (1:nrad_mask) = & +!! pack(this_view % satazi_1d % local (1:nrad_local), domainmask_1d ) +!! this_view % iy_1d % local (1:nrad_mask) = & +!! pack(this_view % iy_1d % local (1:nrad_local), domainmask_1d ) +!! this_view % ix_1d % local (1:nrad_mask) = & +!! pack(this_view % ix_1d % local (1:nrad_local), domainmask_1d ) +!! this_view % loc_1d % local (1:nrad_mask) % y = & +!! pack(this_view % loc_1d % local (1:nrad_local) % y, domainmask_1d ) +!! this_view % loc_1d % local (1:nrad_mask) % x = & +!! pack(this_view % loc_1d % local (1:nrad_local) % x, domainmask_1d ) +! +! !ALLOCATE COMMUNICATION BUFFERS +! allocate ( nbufs ( num_procs ) ) +! allocate ( displs ( num_procs ) ) +!#ifdef DM_PARALLEL +! call mpi_allgather ( nrad_mask, 1, mpi_integer, nbufs, 1, mpi_integer, comm, ierr ) +!#else +! nbufs = nrad_mask +!#endif +! +! displs = 0 +! do iproc = 1, num_procs - 1 +! displs(iproc+1) = displs(iproc) + nbufs(iproc) +! end do +! +! this_view % nrad_on_domain = sum( nbufs ) +! +! allocate( buf_real( this_view % nrad_on_domain, 4 ) ) +! allocate( buf_int ( this_view % nrad_on_domain, 2 ) ) +! allocate( buf_loc ( this_view % nrad_on_domain ) ) +! +! buf_real = missing_r +! buf_int = missing +! buf_loc%y = missing_r +! buf_loc%x = missing_r +! +! !PACK UP DOMAIN DATA FROM THIS PROCESSOR +! buf_i = displs(iproc+1) + 1 +! buf_f = buf_i + nrad_mask - 1 +! buf_real( buf_i:buf_f, 1 ) = & +! pack(this_view % lat_1d % local (1:nrad_local), domainmask_1d ) +! buf_real( buf_i:buf_f, 2 ) = & +! pack(this_view % lon_1d % local (1:nrad_local), domainmask_1d ) +! buf_real( buf_i:buf_f, 3 ) = & +! pack(this_view % satzen_1d % local (1:nrad_local), domainmask_1d ) +! buf_real( buf_i:buf_f, 4 ) = & +! pack(this_view % satazi_1d % local (1:nrad_local), domainmask_1d ) +! buf_int ( buf_i:buf_f, 1 ) = & +! pack(this_view % iy_1d % local (1:nrad_local), domainmask_1d ) +! buf_int ( buf_i:buf_f, 2 ) = & +! pack(this_view % ix_1d % local (1:nrad_local), domainmask_1d ) +! buf_loc ( buf_i:buf_f ) % y = & +! pack(this_view % loc_1d % local (1:nrad_local) % y, domainmask_1d ) +! buf_loc ( buf_i:buf_f ) % x = & +! pack(this_view % loc_1d % local (1:nrad_local) % x, domainmask_1d ) +! +!#ifdef DM_PARALLEL +! !PERFORM COMMS +! +! ! NOTE: MPI_IN_PLACE can only be used when comm is an intracommunicator +! call mpi_allgatherv ( & +! MPI_IN_PLACE, 0, true_mpi_real, buf_real(:,1), nbufs, displs, true_mpi_real, comm, ierr ) +! call mpi_allgatherv ( & +! MPI_IN_PLACE, 0, true_mpi_real, buf_real(:,2), nbufs, displs, true_mpi_real, comm, ierr ) +! call mpi_allgatherv ( & +! MPI_IN_PLACE, 0, true_mpi_real, buf_real(:,3), nbufs, displs, true_mpi_real, comm, ierr ) +! call mpi_allgatherv ( & +! MPI_IN_PLACE, 0, true_mpi_real, buf_real(:,4), nbufs, displs, true_mpi_real, comm, ierr ) +! call mpi_allgatherv ( & +! MPI_IN_PLACE, 0, mpi_integer, buf_int(:,1), nbufs, displs, mpi_integer, comm, ierr ) +! call mpi_allgatherv ( & +! MPI_IN_PLACE, 0, mpi_integer, buf_int(:,2), nbufs, displs, mpi_integer, comm, ierr ) +! call mpi_allgatherv ( & +! MPI_IN_PLACE, 0, true_mpi_real, buf_loc(:)%y, nbufs, displs, true_mpi_real, comm, ierr ) +! call mpi_allgatherv ( & +! MPI_IN_PLACE, 0, true_mpi_real, buf_loc(:)%x, nbufs, displs, true_mpi_real, comm, ierr ) +! +!! call mpi_allgatherv ( & +!! this_view % lat_1d % local (1:nrad_mask), nrad_mask, true_mpi_real, & +!! buf_real(:,1), nbufs, displs, true_mpi_real, comm, ierr ) +!! call mpi_allgatherv ( & +!! this_view % lon_1d % local (1:nrad_mask), nrad_mask, true_mpi_real, & +!! buf_real(:,2), nbufs, displs, true_mpi_real, comm, ierr ) +!! call mpi_allgatherv ( & +!! this_view % satzen_1d % local (1:nrad_mask), nrad_mask, true_mpi_real, & +!! buf_real(:,3), nbufs, displs, true_mpi_real, comm, ierr ) +!! call mpi_allgatherv ( & +!! this_view % satazi_1d % local (1:nrad_mask), nrad_mask, true_mpi_real, & +!! buf_real(:,4), nbufs, displs, true_mpi_real, comm, ierr ) +!! call mpi_allgatherv ( & +!! this_view % iy_1d % local (1:nrad_mask), nrad_mask, mpi_integer, & +!! buf_int(:,1), nbufs, displs, mpi_integer, comm, ierr ) +!! call mpi_allgatherv ( & +!! this_view % ix_1d % local (1:nrad_mask), nrad_mask, mpi_integer, & +!! buf_int(:,2), nbufs, displs, mpi_integer, comm, ierr ) +!! call mpi_allgatherv ( & +!! this_view % loc_1d % local (1:nrad_mask) % y, nrad_mask, true_mpi_real, & +!! buf_loc(:)%y, nbufs, displs, true_mpi_real, comm, ierr ) +!! call mpi_allgatherv ( & +!! this_view % loc_1d % local (1:nrad_mask) % x, nrad_mask, true_mpi_real, & +!! buf_loc(:)%x, nbufs, displs, true_mpi_real, comm, ierr ) +!!#else +!! buf_real( :, 1 ) = this_view % lat_1d % local (1:nrad_mask) +!! buf_real( :, 2 ) = this_view % lon_1d % local (1:nrad_mask) +!! buf_real( :, 3 ) = this_view % satzen_1d % local (1:nrad_mask) +!! buf_real( :, 4 ) = this_view % satazi_1d % local (1:nrad_mask) +!! buf_int ( :, 1 ) = this_view % iy_1d % local (1:nrad_mask) +!! buf_int ( :, 2 ) = this_view % ix_1d % local (1:nrad_mask) +!! buf_loc ( : ) % y = this_view % loc_1d % local (1:nrad_mask) % y +!! buf_loc ( : ) % x = this_view % loc_1d % local (1:nrad_mask) % x +!#endif +! deallocate ( nbufs, displs ) +! ! END SOLUTION 1 + + ! BEGIN SOLUTION 2 + !ALLOCATE COMMUNICATION BUFFERS +#ifdef DM_PARALLEL + call mpi_allreduce( nrad_mask, nbuf, 1, mpi_integer, mpi_sum, comm, ierr ) +#else + nbuf = nrad_mask +#endif + allocate( buf_real( nbuf, 4 ) ) + allocate( buf_int ( nbuf, 2 ) ) + allocate( buf_loc ( nbuf ) ) + + this_view % nrad_on_domain = nbuf + + buf_f = 0 + ProcLoop: do iproc = 0, num_procs-1 + nbuf = nrad_mask +#ifdef DM_PARALLEL + call mpi_bcast(nbuf, 1, mpi_integer, iproc, comm, ierr ) +#endif + if (nbuf .eq. 0) cycle ProcLoop + buf_i = buf_f + 1 + buf_f = buf_i + nbuf - 1 + + if (iproc .eq. myproc) then + !PACK UP DATA FROM THIS PROCESSOR + buf_real( buf_i:buf_f, 1 ) = & + pack(this_view % lat_1d % local (1:nrad_local), domainmask_1d ) + buf_real( buf_i:buf_f, 2 ) = & + pack(this_view % lon_1d % local (1:nrad_local), domainmask_1d ) + buf_real( buf_i:buf_f, 3 ) = & + pack(this_view % satzen_1d % local (1:nrad_local), domainmask_1d ) + buf_real( buf_i:buf_f, 4 ) = & + pack(this_view % satazi_1d % local (1:nrad_local), domainmask_1d ) + buf_int ( buf_i:buf_f, 1 ) = & + pack(this_view % iy_1d % local (1:nrad_local), domainmask_1d ) + buf_int ( buf_i:buf_f, 2 ) = & + pack(this_view % ix_1d % local (1:nrad_local), domainmask_1d ) + + buf_loc ( buf_i:buf_f ) % y = & + pack(this_view % loc_1d % local (1:nrad_local) % y, domainmask_1d ) + buf_loc ( buf_i:buf_f ) % x = & + pack(this_view % loc_1d % local (1:nrad_local) % x, domainmask_1d ) + else + buf_real(buf_i:buf_f,:) = missing_r + buf_int(buf_i:buf_f,:) = missing +! buf_loc(buf_i:buf_f)%y = missing_r +! buf_loc(buf_i:buf_f)%x = missing_r + end if +#ifdef DM_PARALLEL + !PERFORM COMMS + call mpi_bcast(buf_real(buf_i:buf_f,:), nbuf * 4, true_mpi_real, iproc, comm, ierr ) + call mpi_bcast(buf_int (buf_i:buf_f,:), nbuf * 2, mpi_integer, iproc, comm, ierr ) + + !Only x & y components of loc need to be communicated + call mpi_bcast( buf_loc(buf_i:buf_f)%y, nbuf, true_mpi_real, iproc, comm, ierr ) + call mpi_bcast( buf_loc(buf_i:buf_f)%x, nbuf, true_mpi_real, iproc, comm, ierr ) +#endif + end do ProcLoop + ! END SOLUTION 2 + + deallocate ( this_view % lat_1d % local ) + deallocate ( this_view % lon_1d % local ) + deallocate ( this_view % satzen_1d % local ) + deallocate ( this_view % satazi_1d % local ) + deallocate ( this_view % iy_1d % local ) + deallocate ( this_view % ix_1d % local ) + deallocate ( this_view % loc_1d % local ) + deallocate ( domainmask_1d ) + + ! ASSOCIATE REMOTE POINTERS WITH BUFFERS CONTAINING DOMAIN-WIDE OBS + this_view % lat_1d % domain => buf_real(:,1) + this_view % lon_1d % domain => buf_real(:,2) + this_view % satzen_1d % domain => buf_real(:,3) + this_view % satazi_1d % domain => buf_real(:,4) + this_view % iy_1d % domain => buf_int (:,1) + this_view % ix_1d % domain => buf_int (:,2) + this_view % loc_1d % domain => buf_loc (:) + write(unit=stdout,fmt='(3A,I0)') & + ' ',trim(this_view % name),' locations within domain: ', this_view % nrad_on_domain + + ! Populate remainder of loc and determine in/outside patch + allocate ( patchmask_1d (this_view % nrad_on_domain) ) + allocate ( dummybool_2d (this_view % nrad_on_domain,1) ) + call da_llxy_1d ( locs = buf_loc, outside = dummybool_2d(:,1), do_xy = .false. ) + patchmask_1d = .not.dummybool_2d(:,1) + deallocate( dummybool_2d ) + this_view % nrad_on_patch = count(patchmask_1d) + write(unit=stdout,fmt='(3A,I0)') & + ' ',trim(this_view % name),' locations within this subdomain: ', this_view % nrad_on_patch + + if ( this_view % nrad_on_patch .gt. 0 ) then + if ( allocated ( this_view % patchmask ) ) then + deallocate ( this_view % patchmask ) + deallocate ( this_view % lat_1d % patch ) + deallocate ( this_view % lon_1d % patch ) + deallocate ( this_view % satzen_1d % patch ) + deallocate ( this_view % satazi_1d % patch ) + deallocate ( this_view % iy_1d % patch ) + deallocate ( this_view % ix_1d % patch ) + deallocate ( this_view % loc_1d % patch ) + end if + allocate( this_view % lat_1d % patch (this_view % nrad_on_patch) ) + allocate( this_view % lon_1d % patch (this_view % nrad_on_patch) ) + allocate( this_view % satzen_1d % patch (this_view % nrad_on_patch) ) + allocate( this_view % satazi_1d % patch (this_view % nrad_on_patch) ) + allocate( this_view % iy_1d % patch (this_view % nrad_on_patch) ) + allocate( this_view % ix_1d % patch (this_view % nrad_on_patch) ) + allocate( this_view % loc_1d % patch (this_view % nrad_on_patch) ) + + this_view % lat_1d % patch = & + pack( this_view % lat_1d % domain, patchmask_1d ) + this_view % lon_1d % patch = & + pack( this_view % lon_1d % domain, patchmask_1d ) + this_view % satzen_1d % patch = & + pack( this_view % satzen_1d % domain, patchmask_1d ) + this_view % satazi_1d % patch = & + pack( this_view % satazi_1d % domain, patchmask_1d ) + this_view % iy_1d % patch = & + pack( this_view % iy_1d % domain, patchmask_1d ) + this_view % ix_1d % patch = & + pack( this_view % ix_1d % domain, patchmask_1d ) + this_view % loc_1d % patch = & + pack( this_view % loc_1d % domain, patchmask_1d ) + + ! Determine grid extents for this patch on this_view and on Full Disk + this_view % ys_p = minval(this_view % iy_1d % patch) + this_view % ye_p = maxval(this_view % iy_1d % patch) + this_view % xs_p = minval(this_view % ix_1d % patch) + this_view % xe_p = maxval(this_view % ix_1d % patch) + this_view % ys_p_fd = this_view % ys_p + this_view % yoff_fd - 1 + this_view % ye_p_fd = this_view % ye_p + this_view % yoff_fd - 1 + this_view % xs_p_fd = this_view % xs_p + this_view % xoff_fd - 1 + this_view % xe_p_fd = this_view % xe_p + this_view % xoff_fd - 1 + +! write(stdout,*) 'ABI grid extents for this view:' +! write(stdout,'(A,4I10)') 'ys_p, ye_p, xs_p, xe_p ',this_view % ys_p, this_view % ye_p, this_view % xs_p, this_view % xe_p +! write(stdout,*) 'ABI grid extents for Full Disk:' +! write(stdout,'(A,4I10)') 'ys_p_fd, ye_p_fd, xs_p_fd, xe_p_fd',this_view % ys_p_fd, this_view % ye_p_fd, this_view % xs_p_fd, this_view % xe_p_fd + + ! Setup ZZ clddet extents + this_view % ys_local = max(this_view % ys_p - abi_halo_width, 1) + this_view % ye_local = min(this_view % ye_p + abi_halo_width, ny_global) + this_view % xs_local = max(this_view % xs_p - abi_halo_width, 1) + this_view % xe_local = min(this_view % xe_p + abi_halo_width, nx_global) + + ! Setup patch mask for this view, including ZZ clddet buffer + allocate( this_view % patchmask( & + this_view % ys_local:this_view % ye_local, & + this_view % xs_local:this_view % xe_local, 2 ) ) + + this_view % patchmask = .false. + do n = 1, this_view % nrad_on_patch + iy = this_view % iy_1d % patch (n) + ix = this_view % ix_1d % patch (n) + + cldqc = .true. + do jy = iy - abi_halo_width, iy + abi_halo_width + do jx = ix - abi_halo_width, ix + abi_halo_width + if ( & + jy.ge.1 .and. jy.le.ny_global & + .and. jx.ge.1 .and. jx.le.nx_global & + ) then + this_view % patchmask ( jy, jx, 2 ) = .true. + else + cldqc = .false. + end if + end do + end do + this_view % patchmask ( iy, ix, 1 ) = cldqc + end do + this_view % nrad_on_patch_cldqc = count( this_view % patchmask (:,:,1) ) + else + this_view % nrad_on_patch_cldqc = 0 + end if +! write(unit=stdout,fmt='(3A,I0)') & +! ' ',trim(this_view % name),' locations within this subdomain eligible for ZZ clddet: ', this_view % nrad_on_patch_cldqc + + + !FREE UP POINTERS AND BUFFERS + nullify ( this_view % lat_1d % domain ) + nullify ( this_view % lon_1d % domain ) + nullify ( this_view % satzen_1d % domain ) + nullify ( this_view % satazi_1d % domain ) + nullify ( this_view % iy_1d % domain ) + nullify ( this_view % ix_1d % domain ) + nullify ( this_view % loc_1d % domain ) + deallocate ( buf_real, buf_int, buf_loc ) + deallocate ( patchmask_1d ) + +#ifdef DM_PARALLEL + call mpi_allreduce( this_view % nrad_on_patch_cldqc, & + this_view % nrad_on_domain_cldqc, & + 1, mpi_integer, mpi_sum, comm, ierr ) + call mpi_barrier(comm, ierr) +#else + this_view % nrad_on_domain_cldqc = this_view % nrad_on_patch_cldqc +#endif + end if DoGridGen + + if ( iview.eq.1 .and. ipass.lt.npass .and. & + sum(this_view % nfiles_used(:)).eq.0 ) then + if ( this_view % nrad_on_patch_cldqc .gt. 0 ) then + allocate( view_mask( & + this_view % ys_p_fd-2:this_view % ye_p_fd+2, & + this_view % xs_p_fd-2:this_view % xe_p_fd+2, & + nviews, nchan, num_fgat_time ) ) + view_mask = .false. + end if + use_view_mask = .true. + end if + +! if ( (ipass.lt.npass .and. iview.eq.1) .or. .not.use_view_mask ) then +! num_goesabi_global = num_goesabi_global + this_view % nrad_on_domain_cldqc +! !ptotal(ifgat) = ptotal(ifgat) + this_view % nrad_on_domain_cldqc +! end if + + PatchMatch: if (this_view % nrad_on_patch_cldqc .gt. 0) then + + ! Loop over channels; each process reads radiance data only for its subdomain + ChannelLoop: do ichan = 1, nchan + ifile = 0 + do jfile = 1, this_view % nfiles + if ( .not. this_view % file_fgat_match(jfile,ifgat) ) cycle + call get_ichan(this_view % filechan(jfile), channel_list, nchan, jchan) + if ( ichan .eq. jchan ) then + ifile = jfile + exit + end if + end do + if ( ifile .eq. 0 ) cycle ChannelLoop + + this_view % nfiles_used(ifgat) = this_view % nfiles_used(ifgat) + 1 + + VIEW_SELECT: & + if ( ipass.lt.npass .and. use_view_mask ) then + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !! Determine which view has the closest observed + !! time to fgat for this channel + !! Note: this only needs to be done for a single channel, + !! unless individual channel files are missing at fgat. + !! Solution where file view availability differs by channel used here. + !! (only available when FD data present for one of the fgat times) + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + if ( iview.eq.1 ) then + do n = 1, this_view % nrad_on_patch + iy = this_view % iy_1d % patch (n) + ix = this_view % ix_1d % patch (n) + iyfd = iy + this_view % yoff_fd-1 + ixfd = ix + this_view % xoff_fd-1 + view_mask( iyfd, ixfd, iview, ichan, ifgat) = & + this_view % patchmask ( iy, ix, 1 ) + end do + else + best_view = .true. +! do jview = 1, iview-1 !This assumes MESO1 and MESO2 are in identical locations + do jview = 1, min(iview-1,2) !This assumes MESO1 and MESO2 do not overlap + best_view = best_view .and. & + this_view % min_time_diff(ichan, ifgat) .lt. & + view_att(jview) % min_time_diff(ichan, ifgat) + end do + if ( best_view ) then + do n = 1, this_view % nrad_on_patch + iy = this_view % iy_1d % patch (n) + ix = this_view % ix_1d % patch (n) + if ( this_view % patchmask ( iy, ix, 1 ) ) then + iyfd = iy + this_view % yoff_fd-1 + ixfd = ix + this_view % xoff_fd-1 + + view_mask( iyfd, ixfd, iview, ichan, ifgat) = .true. + + !This assumes MESO1 and MESO2 do not overlap + view_mask( iyfd, ixfd, 1:min(iview-1,2), ichan, ifgat) = .false. + +! !This assumes MESO1 and MESO2 are in identical locations +! view_mask( iyfd, ixfd, 1:iview-1, ichan, ifgat) = .false. + end if + end do + end if + end if + + else + !!Utilizing these masks to eliminate data: + !! + earthmask + !! + zenmask + !! + view_mask [only if npass > 1] + !! + model domain mask + !! + patch mask + !! + thinning + + allocate( allmask_p( & + this_view % ys_local:this_view % ye_local, & + this_view % xs_local:this_view % xe_local ) ) + allmask_p = this_view % patchmask ( & + this_view % ys_local:this_view % ye_local, & + this_view % xs_local:this_view % xe_local, 1 ) + + allocate( readmask_p( & + this_view % ys_local:this_view % ye_local, & + this_view % xs_local:this_view % xe_local ) ) + readmask_p = this_view % patchmask ( & + this_view % ys_local:this_view % ye_local, & + this_view % xs_local:this_view % xe_local, 2 ) + + ! Only use locations where this view is nearest to this fgat time + ! - only available when FD data present for any fgat time + if ( use_view_mask ) then + if ( .not.any( & + view_mask ( this_view % ys_p_fd:this_view % ye_p_fd, & + this_view % xs_p_fd:this_view % xe_p_fd, & + iview, ichan, ifgat ) & + ) ) then + deallocate(allmask_p, readmask_p) + write(unit=stdout,fmt='(3A,I0)') & + ' ZERO pixels selected for ',trim(this_view % name),' on band ', channel_list(ichan) + this_view % nfiles_used(ifgat) = this_view % nfiles_used(ifgat) - 1 + cycle ChannelLoop + end if + do n = 1, this_view % nrad_on_patch + iy = this_view % iy_1d % patch (n) + ix = this_view % ix_1d % patch (n) + iyfd = iy + this_view % yoff_fd-1 + ixfd = ix + this_view % xoff_fd-1 + + allmask_p( iy, ix ) = & + ( allmask_p( iy, ix ) .and. view_mask( iyfd, ixfd, iview, ichan, ifgat) ) + + readmask_p( iy, ix ) = & + ( readmask_p( iy, ix ) .and. view_mask( iyfd, ixfd, iview, ichan, ifgat) ) + end do + end if + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !! Read radiance and convert to brightness temp. + !! once per permutation of + !! + INST VIEW (FD, CONUS, MESOx2) + !! + fgat + !! + channel/band + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(unit=stdout,fmt='(A,I0,A,I0)') & + ' Reading ', count(readmask_p), ' abi radiances for band ',channel_list(ichan) + if ( use_clddet_zz) write(unit=stdout,fmt='(A,I0)') & + ' which includes the cloud detection halo' + TEMPIR_ifile = -1 + if ( use_clddet_zz .and. channel_list(ichan).eq.14 ) then + ! Require earlier file to be withn 1/2 of TEMPIR_delay_minutes + TEMPIR_min_time_diff = TEMPIR_delay_minutes +!write(unit=stdout,fmt='(A,F14.2)') & +! ' ref_time (min): ', this_view % filedate(ifile) % obs_time / 60.D0 - TEMPIR_delay_minutes + do jfile = 1, this_view % nfiles + if ( this_view % filechan(jfile) .ne. channel_list(ichan) .or. & + jfile .eq. ifile ) cycle + + TEMPIR_time_abs_diff = & + abs( this_view % filedate(jfile) % obs_time / 60.D0 - & + (this_view % filedate(ifile) % obs_time / 60.D0 - TEMPIR_delay_minutes) ) + + if ( TEMPIR_time_abs_diff .lt. TEMPIR_min_time_diff ) then + TEMPIR_ifile = jfile + TEMPIR_min_time_diff = TEMPIR_time_abs_diff + end if + end do + if ( TEMPIR_min_time_diff .gt. 0.5 * TEMPIR_delay_minutes ) then +! write(unit=stdout,fmt='(A,F7.2,A)') & +! ' TEMPIR: minimum time difference is too large - ',TEMPIR_min_time_diff,' minutes' + TEMPIR_ifile = -1 +! else +! write(unit=stdout,fmt='(A,F7.2,A)') & +! ' TEMPIR: minimum time difference is accetable - ',TEMPIR_min_time_diff,' minutes' + end if + end if + + ! Allocate and read bt for this patch and current time + if ( TEMPIR_ifile.gt.0 ) then + allocate( rad_p ( & + this_view % ys_local:this_view % ye_local, & + this_view % xs_local:this_view % xe_local, 2 ) ) + + allocate( bt_p ( & + this_view % ys_local:this_view % ye_local, & + this_view % xs_local:this_view % xe_local, 2 ) ) + else + allocate( rad_p ( & + this_view % ys_local:this_view % ye_local, & + this_view % xs_local:this_view % xe_local, 1 ) ) + + allocate( bt_p ( & + this_view % ys_local:this_view % ye_local, & + this_view % xs_local:this_view % xe_local, 1 ) ) + end if + + fname = trim(this_view % filename(ifile)) + call get_abil1b_rad( fname, & + this_view % ys_local, this_view % ye_local, & + this_view % xs_local, this_view % xe_local, & + readmask_p, inst, ichan, & + rad_p(:,:,1), bc1, bc2, fk1, fk2 ) + + bt_p = missing_r + where (readmask_p) + bt_p(:,:,1) = rad2bt(rad_p(:,:,1), bc1, bc2, fk1, fk2) + end where + + !JJG: It is possible for readmask_p to differ across channels. + ! readmask_p needs to be incorporated, but presently causes error between channel reading + ! when lining up channels to identical members of linked p list. + ! Fixing this will require moving away from linked list including the readmask_p quality + ! flag in the datalink_type. + ! Presently readmask_p is used internally within get_abil1b_rad to set rad_p=missing_r (works fine) + !allmask_p = (allmask_p .and. readmask_p) + if ( TEMPIR_ifile.gt.0 ) then + fname = trim(this_view % filename(TEMPIR_ifile)) + call get_abil1b_rad( fname, & + this_view % ys_local, this_view % ye_local, & + this_view % xs_local, this_view % xe_local, & + readmask_p, inst, ichan, & + rad_p(:,:,2), bc1, bc2, fk1, fk2 ) + + where (readmask_p) + bt_p(:,:,2) = rad2bt(rad_p(:,:,2), bc1, bc2, fk1, fk2) + end where + + yr = this_view % filedate(TEMPIR_ifile) % yr + mt = this_view % filedate(TEMPIR_ifile) % mt + dy = this_view % filedate(TEMPIR_ifile) % dy + hr = this_view % filedate(TEMPIR_ifile) % hr + mn = this_view % filedate(TEMPIR_ifile) % mn + sc = this_view % filedate(TEMPIR_ifile) % sc +! write(unit=stdout, & +! fmt='(A,I4.4,A,I2.2,A,I2.2,A,I2.2,A,I2.2,A,I2.2)') & +! ' TEMPIR time: ',yr, '-', mt, '-', dy, '_', hr, ':', mn, ':', sc + end if + + first_chan = (this_view % nfiles_used(ifgat).eq.1) + + !! Write bt, lat, lon, satzen, satazi, solzen, solazi to datalink structures + if (first_chan) then + p_fgat => p + + yr = this_view % filedate(ifile) % yr + mt = this_view % filedate(ifile) % mt + dy = this_view % filedate(ifile) % dy + hr = this_view % filedate(ifile) % hr + mn = this_view % filedate(ifile) % mn + sc = this_view % filedate(ifile) % sc + + allocate( solzen_1d (this_view % nrad_on_patch) ) + allocate( solazi_1d (this_view % nrad_on_patch) ) + + call da_get_solar_angles_1d ( yr, mt, dy, hr, mn, sc, & + this_view % lat_1d % patch, this_view % lon_1d % patch, & + solzen_1d, solazi_1d ) + + if ( use_clddet_zz .and. & + abi_halo_width-abi_superob_halfwidth.ge.1) then + ! Allocate terrain_hgt using local indices for this view + allocate( terrain_hgt ( & + this_view % ys_local:this_view % ye_local, & + this_view % xs_local:this_view % xe_local ) ) + + ! Read terrain file using Full Disk global indices + write(*,*) 'DEBUG da_read_obs_ncgoesabi, ys_local, ye_local, yoff_fd-1: ', & + this_view % ys_local, this_view % ye_local, this_view % yoff_fd-1 + write(*,*) 'DEBUG da_read_obs_ncgoesabi, xs_local, xe_local, xoff_fd-1: ', & + this_view % xs_local, this_view % xe_local, this_view % xoff_fd-1 + + call get_abil1b_terr( terr_fname, & + this_view % ys_local + this_view % yoff_fd - 1, & + this_view % ye_local + this_view % yoff_fd - 1, & + this_view % xs_local + this_view % xoff_fd - 1, & + this_view % xe_local + this_view % xoff_fd - 1, & + terrain_hgt ) + + end if + + allocate(thinmask(this_view % ys_p:this_view % ye_p, & + this_view % xs_p:this_view % xe_p)) + thinmask = .false. + else + p => p_fgat + end if + + PixelLoop: do n = 1, this_view % nrad_on_patch + iy = this_view % iy_1d % patch (n) + ix = this_view % ix_1d % patch (n) + + if (.not. allmask_p( iy, ix )) cycle PixelLoop + + if (first_chan) then + info % lat = this_view % lat_1d % patch (n) ! latitude + info % lon = this_view % lon_1d % patch (n) ! longitude + num_goesabi_local = num_goesabi_local + 1 + end if + + if (thinning) then + if (first_chan) then + dlat_earth = info % lat + dlon_earth = info % lon + if (dlon_earth=r360) dlon_earth = dlon_earth-r360 + dlat_earth = dlat_earth * deg2rad + dlon_earth = dlon_earth * deg2rad + crit = 1. + call map2grids(inst,ifgat,dlat_earth,dlon_earth,crit,iobs,itx,1,itt,iout,iuse) + if (.not. iuse) then + num_goesabi_thinned=num_goesabi_thinned+1 + thinmask( iy, ix ) = .true. + cycle PixelLoop + end if + else + if (thinmask( iy, ix )) cycle PixelLoop + end if + end if + + if (first_chan) then + num_goesabi_used_fgat(ifgat) = num_goesabi_used_fgat(ifgat) + 1 + + allocate ( p % tb_inv (1:nchan) ) + allocate ( p % rad_obs (1:nchan) ) + p % tb_inv = missing_r + p % rad_obs = missing_r + + write(unit=info % date_char, & + fmt='(I4.4,A,I2.2,A,I2.2,A,I2.2,A,I2.2,A,I2.2)') & + yr, '-', mt, '-', dy, '_', hr, ':', mn, ':', sc + if ( allocated(terrain_hgt) ) then + info % elv = terrain_hgt( iy, ix ) + else + info % elv = 0.0 + end if + p % info = info + p % loc = this_view % loc_1d % patch (n) + + p % landsea_mask = 1 ! ??? + if (use_view_mask) then + p % scanpos = & + ( iy + this_view % yoff_fd-1 - 1) * (nscan+1) / view_att(1) % ny_global + ! ??? "scan" position (IS THIS CORRECT? NECESSARY? iFOV?) + else + p % scanpos = & + ( iy + this_view % yoff_fd-1 - 1) * (nscan+1) / 5424 + ! ??? "scan" position (IS THIS CORRECT? NECESSARY? iFOV?) + end if + p % satzen = this_view % satzen_1d % patch (n) + p % satazi = this_view % satazi_1d % patch (n) + p % solzen = solzen_1d (n) + p % solazi = solazi_1d (n) + if ( p % solzen < 0. ) p % solzen = 150. + p % sensor_index = inst + p % ifgat = ifgat + end if + + ! Super-ob the radiance, then convert to BT for this channel + tbuf = abi_superob_halfwidth + if (abi_halo_width.ge.tbuf .and. tbuf.gt.0) then + ! require that nkeep >= superob_width to filter out bad data + nkeep = count ( rad_p ( iy-tbuf:iy+tbuf, ix-tbuf:ix+tbuf, 1 ) .gt. 0.0 ) + if (nkeep .ge. superob_width) then + p % rad_obs(ichan) = sum( pack( & + rad_p ( iy-tbuf:iy+tbuf, ix-tbuf:ix+tbuf, 1 ), & + rad_p ( iy-tbuf:iy+tbuf, ix-tbuf:ix+tbuf, 1 ) .gt. 0.0 ) ) & + / real(nkeep,r_double) + end if + else + ! Extract single pixel BT and radiance value for this channel + p % rad_obs(ichan) = rad_p( iy, ix, 1 ) + end if + if (p % rad_obs(ichan) .gt. 0.0) then + p % tb_inv(ichan) = rad2bt(p % rad_obs(ichan), bc1, bc2, fk1, fk2 ) + end if + + ! Preprocessing for Cloud Mask (da_qc_goesabi.inc) including + ! extracting Tb values from cloud QC buffer + if (.not. allocated(p % superob)) then + allocate( p % superob(superob_width,superob_width) ) + end if + + ! Loops over superob pixels + do jsup = 1, superob_width + do isup = 1, superob_width + iysup = iy + jsup-1-abi_superob_halfwidth + ixsup = ix + isup-1-abi_superob_halfwidth + if (first_chan) then + allocate ( p % superob(isup,jsup) % tb_obs (1:nchan,1) ) + allocate ( p % superob(isup,jsup) % cld_qc(1) ) + allocate ( p % superob(isup,jsup) % cld_qc(1) % tb_stddev_3x3(nchan) ) + end if + p % superob(isup,jsup) % tb_obs(ichan,1) = bt_p( iysup, ixsup, 1 ) + + tbuf = 1 + if (abi_halo_width-abi_superob_halfwidth.ge.tbuf .and. & + bt_p( iysup, ixsup, 1 ).gt.0.0) then + nkeep = count ( bt_p ( iysup-tbuf:iysup+tbuf, ixsup-tbuf:ixsup+tbuf, 1 ) .gt. 0.0 ) + if (nkeep .gt. 0) then + allocate( tb_temp ( nkeep, 1 ) ) + tb_temp(:,1) = pack( bt_p ( iysup-tbuf:iysup+tbuf, ixsup-tbuf:ixsup+tbuf, 1 ), & + bt_p ( iysup-tbuf:iysup+tbuf, ixsup-tbuf:ixsup+tbuf, 1 ) .gt. 0.0) + mu = sum( tb_temp(:,1) ) / real(nkeep,r_double) + sigma = sqrt( sum( (tb_temp(:,1) - mu)**2 ) / real(nkeep,r_double) ) + deallocate( tb_temp ) + + p % superob(isup,jsup) % cld_qc(1) % tb_stddev_3x3(ichan) = sigma + else + p % superob(isup,jsup) % cld_qc(1) % tb_stddev_3x3(ichan) = missing_r + end if + if (channel_list(ichan).eq.14) then + + if ( allocated(terrain_hgt) ) then + ! Determine sigma_z of terrain height across these pixels + p % superob(isup,jsup) % cld_qc(1) % terr_hgt = terrain_hgt( iysup, ixsup ) + nkeep = count ( terrain_hgt ( iysup-tbuf:iysup+tbuf, ixsup-tbuf:ixsup+tbuf ) .gt. missing_r ) + if (nkeep .gt. 0) then + allocate( tb_temp ( nkeep, 1 ) ) + tb_temp(:,1) = pack( terrain_hgt ( iysup-tbuf:iysup+tbuf, ixsup-tbuf:ixsup+tbuf ), & + terrain_hgt ( iysup-tbuf:iysup+tbuf, ixsup-tbuf:ixsup+tbuf ) .gt. missing_r) + mu = sum( tb_temp(:,1) ) / real(nkeep,r_double) + sigma = sqrt( sum( (tb_temp(:,1) - mu)**2 ) / real(nkeep,r_double) ) + deallocate( tb_temp ) + + ! Values for RTCT cloud QC + ! - channel 14 and sigma_z (std. dev. of terrain height in km) + ! w/ landmask and lapse rate of 7 K km^-1 + + temp_max = 0. + do jy = iysup-tbuf, iysup+tbuf + do jx = ixsup-tbuf, ixsup+tbuf + if ( bt_p( jy, jx, 1) .gt. 0. ) & + temp_max = max(temp_max,bt_p( jy, jx, 1 ) ) + end do + end do + + if (temp_max .gt. missing_r) then + ! Store RTCT + p % superob(isup,jsup) % cld_qc(1) % RTCT = temp_max - bt_p( iysup, ixsup, 1 ) - & + 3.0_r_double * 0.007_r_double * sigma + else + p % superob(isup,jsup) % cld_qc(1) % RTCT = missing_r + end if + else + p % superob(isup,jsup) % cld_qc(1) % RTCT = missing_r + end if + else + p % superob(isup,jsup) % cld_qc(1) % RTCT = missing_r + p % superob(isup,jsup) % cld_qc(1) % terr_hgt = missing_r + end if + + end if + else + p % superob(isup,jsup) % cld_qc(1) % tb_stddev_3x3(ichan) = missing_r + if (channel_list(ichan).eq.14) then + p % superob(isup,jsup) % cld_qc(1) % RTCT = missing_r + p % superob(isup,jsup) % cld_qc(1) % terr_hgt = missing_r + end if + end if + + ! Values for RFMFT cloud QC + ! - channels 14 and 15 + tbuf = 10 + if (abi_halo_width-abi_superob_halfwidth.ge.tbuf .and. & + bt_p( iysup, ixsup, 1 ).gt.0.0) then + if (channel_list(ichan).eq.14) then + p % superob(isup,jsup) % cld_qc(1) % RFMFT_ij = -1 + + !Determine Neighboring Warm Center (NWC) for this pixel + temp_max = 0.0 + do jy = iysup-tbuf, iysup+tbuf + do jx = ixsup-tbuf, ixsup+tbuf + if ( bt_p( jy, jx, 1 ) .gt. temp_max ) then + temp_max = bt_p( jy, jx, 1 ) + p % superob(isup,jsup) % cld_qc(1) % RFMFT_ij(1) = jy + p % superob(isup,jsup) % cld_qc(1) % RFMFT_ij(2) = jx + end if + end do + end do + p % superob(isup,jsup) % cld_qc(1) % RFMFT = & + bt_p( iysup, ixsup, 1 ) - temp_max + end if + if (channel_list(ichan).eq.15 .and. & + all(p % superob(isup,jsup) % cld_qc(1) % RFMFT_ij.gt.0)) then + + temp_max = bt_p ( p % superob(isup,jsup) % cld_qc(1) % RFMFT_ij(1), & + p % superob(isup,jsup) % cld_qc(1) % RFMFT_ij(2), 1 ) + + p % superob(isup,jsup) % cld_qc(1) % RFMFT = abs( & + p % superob(isup,jsup) % cld_qc(1) % RFMFT + & + temp_max - bt_p( iysup, ixsup, 1 ) ) + + end if + else + if ( any( channel_list(ichan).eq.(/14,15/) ) ) then + + p % superob(isup,jsup) % cld_qc(1) % RFMFT = missing_r + + p % superob(isup,jsup) % cld_qc(1) % RFMFT_ij = -1 + + end if + end if + + ! Values for CIRH2O cloud QC + ! - channels 10 and 14 for Pearson correlation coefficient of CIRH2O test + tbuf = 2 + if (abi_halo_width-abi_superob_halfwidth.ge.tbuf .and. & + bt_p( iysup, ixsup, 1 ).gt.0.0) then + + if (channel_list(ichan).eq.10) then + + allocate( p % superob(isup,jsup) % cld_qc(1) % CIRH2O_abi ( & + iysup-tbuf:iysup+tbuf, ixsup-tbuf:ixsup+tbuf, 2 ) ) + + p % superob(isup,jsup) % cld_qc(1) % CIRH2O_abi(:,:,1) = & + bt_p( iysup-tbuf:iysup+tbuf, ixsup-tbuf:ixsup+tbuf, 1 ) + + end if + if (channel_list(ichan).eq.14 .and. & + size(p % superob(isup,jsup) % cld_qc(1) % CIRH2O_abi).gt.1) then + + p % superob(isup,jsup) % cld_qc(1) % CIRH2O_abi(:,:,2) = & + bt_p( iysup-tbuf:iysup+tbuf, ixsup-tbuf:ixsup+tbuf, 1 ) + nkeep = 0 + do jy = iysup-tbuf, iysup+tbuf + do jx = ixsup-tbuf, ixsup+tbuf + if ( all(p % superob(isup,jsup) % cld_qc(1) % CIRH2O_abi( jy, jx, : ) .gt. missing_r) ) nkeep = nkeep + 1 + end do + end do + allocate( tb_temp ( nkeep, 2 ) ) + ikeep = 0 + do jy = iysup-tbuf, iysup+tbuf + do jx = ixsup-tbuf, ixsup+tbuf + if ( all(p % superob(isup,jsup) % cld_qc(1) % CIRH2O_abi( jy, jx, : ) .gt. missing_r) ) then + ikeep = ikeep + 1 + tb_temp(ikeep,1) = & + p % superob(isup,jsup) % cld_qc(1) % CIRH2O_abi( jy, jx, 1 ) + tb_temp(ikeep,2) = & + p % superob(isup,jsup) % cld_qc(1) % CIRH2O_abi( jy, jx, 2 ) + end if + end do + end do + + mu10 = sum( tb_temp(:,1) ) / real(nkeep,r_double) + sigma10 = sqrt( sum( (tb_temp(:,1) - mu10)**2 ) & + / real(nkeep,r_double) ) + + mu14 = sum( tb_temp(:,2) ) / real(nkeep,r_double) + sigma14 = sqrt( sum( (tb_temp(:,2) - mu14)**2 ) / & + real(nkeep,r_double) ) + + pearson = sum((tb_temp(:,1) - mu10) * (tb_temp(:,2) - mu14)) / & + real(nkeep,r_double) / ( sigma10 * sigma14 ) + + deallocate( tb_temp ) + deallocate( p % superob(isup,jsup) % cld_qc(1) % CIRH2O_abi ) + !allocate( p % superob(isup,jsup) % cld_qc(1) % CIRH2O_abi (1,1,1) ) + + p % superob(isup,jsup) % cld_qc(1) % CIRH2O = pearson + + end if + else + if ( any( channel_list(ichan).eq.(/10,14/) ) ) then + + if ( allocated( p % superob(isup,jsup) % cld_qc(1) % CIRH2O_abi ) ) & + deallocate( p % superob(isup,jsup) % cld_qc(1) % CIRH2O_abi) + + !allocate( p % superob(isup,jsup) % cld_qc(1) % CIRH2O_abi (1,1,1)) + + p % superob(isup,jsup) % cld_qc(1) % CIRH2O = missing_r + + end if + end if + + ! Values for TEMPIR cloud QC + ! - channel 14 + if ( use_clddet_zz .and. (channel_list(ichan).eq.14) ) then + + p % superob(isup,jsup) % cld_qc(1) % TEMPIR = missing_r + + if ( TEMPIR_ifile.gt.0 .and. & + bt_p( iysup, ixsup, 1 ).gt.0.0 .and. & + bt_p( iysup, ixsup, 2 ).gt.0.0 ) then + if ( bt_p( iysup, ixsup, 2 ).lt.330. ) & + p % superob(isup,jsup) % cld_qc(1) % TEMPIR = & + bt_p( iysup, ixsup, 2 ) - bt_p( iysup, ixsup, 1 ) + end if + + end if + end do ! isup + end do ! jsup + + if (first_chan) & + allocate (p % next) ! add next data + + p => p % next + + if (first_chan) & + nullify (p % next) + + end do PixelLoop + if ( allocated(bt_p) ) deallocate ( bt_p ) + if ( allocated(rad_p) ) deallocate ( rad_p ) + if ( allocated(solzen_1d) ) deallocate ( solzen_1d ) + if ( allocated(solazi_1d) ) deallocate ( solazi_1d ) + if ( allocated(allmask_p) ) deallocate ( allmask_p ) + if ( allocated(readmask_p) ) deallocate ( readmask_p ) + end if VIEW_SELECT + end do ChannelLoop + if ( allocated(terrain_hgt) ) deallocate ( terrain_hgt ) + if ( allocated(thinmask) ) deallocate ( thinmask ) + else + write(unit=stdout,fmt='(A)') & + ' No pixels to read within this subdomain. Waiting for other processors...' + end if PatchMatch + +#ifdef DM_PARALLEL + call mpi_barrier(comm, ierr) +#endif + + end do fgat_loop ! end fgat loop + + if ( (this_view % moving .or. ipass.eq.npass) .and. this_view%nrad_on_patch.gt.0 ) then + ! Deallocate location info + deallocate ( this_view % patchmask ) + deallocate ( this_view % lat_1d % patch ) + deallocate ( this_view % lon_1d % patch ) + deallocate ( this_view % satzen_1d % patch ) + deallocate ( this_view % satazi_1d % patch ) + deallocate ( this_view % iy_1d % patch ) + deallocate ( this_view % ix_1d % patch ) + deallocate ( this_view % loc_1d % patch ) + end if + + if (ipass .eq. 2) tot_files_used = tot_files_used + sum(view_att(iview) % nfiles_used) + + end do ! end view loop + + end do ! end pass loop + + if ( allocated(view_mask) ) deallocate(view_mask) + + do iview = 1, nviews + if ( .not.view_att(iview) % select ) cycle + this_view => view_att(iview) + deallocate ( this_view % filename ) + deallocate ( this_view % filechan ) + deallocate ( this_view % filedate ) + deallocate ( this_view % file_fgat_match ) + deallocate ( this_view % fgat_time_abs_diff ) + deallocate ( this_view % min_time_diff ) + deallocate ( this_view % nfiles_used ) + if ( allocated( this_view % ny_grid ) ) deallocate ( this_view % ny_grid ) + if ( allocated( this_view % nx_grid ) ) deallocate ( this_view % nx_grid ) + if ( allocated( this_view % ys_grid ) ) deallocate ( this_view % ys_grid ) + if ( allocated( this_view % xs_grid ) ) deallocate ( this_view % xs_grid ) + end do + deallocate(view_att) + + if (tot_files_used .lt. 1) then + write(unit=message(1),fmt=*) "Either no L1B data found or no matching fgat windows for GOES-",satellite_id," ABI using prefix ",INST_PREFIX, " for this process rank. This subdomain may have an unacceptable zenith angle or fall entirely outside the GOES viewing extent." + +! write(unit=message(1),fmt='(A)') "Either no L1B data found or no matching" +! write(unit=message(2),fmt='(A,I2,A)') "fgat windows for GOES-",satellite_id," ABI using" +! write(unit=message(3),fmt='(3A)') "prefix ",INST_PREFIX, " for this process rank." +! write(unit=message(4),fmt='(A)') "This subdomain may have an unacceptable zenith " +! write(unit=message(5),fmt='(A)') "angle or fall entirely outside the GOES viewing" +! write(unit=message(6),fmt='(A)') "extent." + + call da_warning(__FILE__,__LINE__, message(1:1)) + end if + +#ifdef DM_PARALLEL + call mpi_allreduce( num_goesabi_local, & + num_goesabi_global, & + 1, mpi_integer, mpi_sum, comm, ierr ) +#else + num_goesabi_global = num_goesabi_local +#endif + +!------------------------------------------------------ + ! NOTE: Remainder of this subroutine modified from da_read_obs_ncgoesimg.inc + + if (thinning .and. num_goesabi_global > 0 ) then +#ifdef DM_PARALLEL + + ! Get minimum crit and associated processor index. + j = 0 + do ifgat = 1, num_fgat_time + j = j + thinning_grid(inst,ifgat) % itxmax + end do + + + allocate ( in (j) ) + allocate ( out (j) ) + j = 0 + do ifgat = 1, num_fgat_time + do i = 1, thinning_grid(inst,ifgat) % itxmax + j = j + 1 + in(j) = thinning_grid(inst,ifgat) % score_crit(i) + end do + end do + + call mpi_reduce(in, out, j, true_mpi_real, mpi_min, root, comm, ierr) + + call wrf_dm_bcast_real (out, j) + + j = 0 + do ifgat = 1, num_fgat_time + do i = 1, thinning_grid(inst,ifgat) % itxmax + j = j + 1 + if ( ABS(out(j)-thinning_grid(inst,ifgat) % score_crit(i)) > 1.0D-10 ) thinning_grid(inst,ifgat) % ibest_obs(i) = 0 + end do + end do + deallocate( in ) + deallocate( out ) + +#endif + ! Delete the nodes being thinned out + p => head + prev => head + head_found = .false. + num_goesabi_used_tmp = sum(num_goesabi_used_fgat) + + do j = 1, num_goesabi_used_tmp + n = p % sensor_index + ifgat = p % ifgat + found = .false. + + do i = 1, thinning_grid(n,ifgat) % itxmax + if ( thinning_grid(n,ifgat) % ibest_obs(i) == j .and. thinning_grid(n,ifgat) % score_crit(i) < 9.99e6_r_double ) then + found = .true. + exit + end if + end do + + ! free current data + if ( .not. found ) then + current => p + p => p % next + if ( head_found ) then + prev % next => p + else + head => p + prev => p + end if + deallocate ( current % tb_inv ) + deallocate ( current % rad_obs ) + if ( allocated( current % superob ) ) then + do jsup = 1, superob_width + do isup = 1, superob_width + deallocate ( current % superob(isup,jsup) % tb_obs ) + if ( allocated ( current % superob(isup,jsup) % cld_qc(1) % CIRH2O_abi ) ) & + deallocate ( current % superob(isup,jsup) % cld_qc(1) % CIRH2O_abi ) + deallocate ( current % superob(isup,jsup) % cld_qc(1) % tb_stddev_3x3 ) + deallocate ( current % superob(isup,jsup) % cld_qc ) + end do + end do + deallocate ( current % superob ) + end if + deallocate ( current ) + num_goesabi_thinned = num_goesabi_thinned + 1 + num_goesabi_used_fgat(ifgat) = num_goesabi_used_fgat(ifgat) - 1 + continue + end if + + if ( found .and. head_found ) then + prev => p + p => p % next + continue + end if + if ( found .and. .not. head_found ) then + head_found = .true. + head => p + prev => p + p => p % next + end if + + end do + + end if ! End of thinning +!stop + num_goesabi_used = sum(num_goesabi_used_fgat) + iv % total_rad_pixel = iv % total_rad_pixel + num_goesabi_used + iv % total_rad_channel = iv % total_rad_channel + num_goesabi_used*nchan + + iv % info(radiance) % nlocal = iv % info(radiance) % nlocal + num_goesabi_used + iv % info(radiance) % ntotal = iv % info(radiance) % ntotal + num_goesabi_global + + do i = 1, num_fgat_time +#ifdef DM_PARALLEL + call mpi_allreduce( num_goesabi_used_fgat(i), & + ptotal(i), & + 1, mpi_integer, mpi_sum, comm, ierr ) +#else + ptotal(i) = num_goesabi_used_fgat(i) +#endif + end do + + do i = 1, num_fgat_time + ptotal(i) = ptotal(i) + ptotal(i-1) + iv % info(radiance) % ptotal(i) = iv % info(radiance) % ptotal(i) + ptotal(i) + end do + +#ifdef DM_PARALLEL + call mpi_allreduce( num_goesabi_thinned, & + nthinned, & + 1, mpi_integer, mpi_sum, comm, ierr ) +#else + nthinned = num_goesabi_thinned +#endif + + if ( iv % info(radiance) % ptotal(num_fgat_time) /= (iv % info(radiance) % ntotal - nthinned) ) then + write(unit=message(1),fmt='(A,I10,A,I10)') & + "Number of ntotal - nthinned:",iv % info(radiance) % ntotal - nthinned," is different from the sum of ptotal:", iv % info(radiance) % ptotal(num_fgat_time) + call da_warning(__FILE__,__LINE__,message(1:1)) + endif + + write(unit=stdout,fmt='(a)') 'num_goesabi_global, num_goesabi_thinned_global, num_goesabi_used_global' + write(unit=stdout,fmt=*) num_goesabi_global, nthinned, ptotal(num_fgat_time) + + write(unit=stdout,fmt='(a)') 'num_goesabi_local, num_goesabi_thinned, num_goesabi_used' + write(unit=stdout,fmt=*) num_goesabi_local, num_goesabi_thinned, num_goesabi_used + + ! 5.0 allocate innovation radiance structure + !---------------------------------------------------------------- + + + if (num_goesabi_used > 0) then + iv % instid(inst) % num_rad = num_goesabi_used + iv % instid(inst) % info % nlocal = num_goesabi_used + write(unit=stdout,FMT='(a,i3,2x,a,3x,i10)') & + 'Allocating space for radiance innov structure', & + inst, iv % instid(inst) % rttovid_string, iv % instid(inst) % num_rad + call da_allocate_rad_iv (inst, nchan, iv) + end if + + ! 6.0 assign sequential structure to innovation structure + !------------------------------------------------------------- + p => head + do n = 1, num_goesabi_used + i = p % sensor_index + call da_initialize_rad_iv (i, n, iv, p) + current => p + p => p % next + + ! free current data + deallocate ( current % tb_inv ) + deallocate ( current % rad_obs ) + if ( allocated ( current % superob ) ) then + do jsup = 1, superob_width + do isup = 1, superob_width + deallocate ( current % superob(isup,jsup) % tb_obs ) + if ( allocated ( current % superob(isup,jsup) % cld_qc(1) % CIRH2O_abi ) ) & + deallocate ( current % superob(isup,jsup) % cld_qc(1) % CIRH2O_abi ) + deallocate ( current % superob(isup,jsup) % cld_qc(1) % tb_stddev_3x3 ) + deallocate ( current % superob(isup,jsup) % cld_qc ) + end do + end do + deallocate ( current % superob ) + end if + deallocate ( current ) + end do + deallocate ( p ) + deallocate (ptotal) + +#ifdef DM_PARALLEL + call mpi_barrier(comm, ierr) +#endif + + if (trace_use) call da_trace_exit("da_read_obs_ncgoesabi") + +end subroutine da_read_obs_ncgoesabi + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +subroutine get_ichan(channel, channel_list, nchan, ichan) !result(ichan) + + implicit none + + integer, intent(in) :: channel, nchan + integer, intent(in) :: channel_list(nchan) + integer, intent(out) :: ichan + integer :: i + + if (trace_use) call da_trace_entry("get_ichan") + + ichan = 0 + do i = 1, nchan + if (channel .eq. channel_list(i)) then + ichan = i + exit + end if + end do + + if (trace_use) call da_trace_exit("get_ichan") + +end subroutine get_ichan + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +subroutine get_abil1b_metadata( filename, & + ydim, xdim, req, rpol, pph, nam) !, lat_sat, lon_sat ) + + implicit none + + character(*), intent(in) :: filename + integer, intent(out) :: ydim, xdim + real(r_double), intent(out) :: req, rpol, pph, nam +!!! real, intent(out) :: lat_sat, lon_sat + + integer :: ierr, ncid, varid, dimid + + if (trace_use) call da_trace_entry("get_abil1b_metadata") + + ierr=nf_open(trim(filename),nf_nowrite,ncid) + call handle_err('Error opening file',ierr) + + !! Determine ABI satellite parameters (optional outputs) + ierr=nf_inq_dimid(ncid,'y',dimid) + ierr=nf_inq_dimlen(ncid,dimid,ydim) + ierr=nf_inq_dimid(ncid,'x',dimid) + ierr=nf_inq_dimlen(ncid,dimid,xdim) + + ierr=nf_inq_varid(ncid,'goes_imager_projection',varid) + ierr=nf_get_att_double(ncid,varid,'semi_major_axis',req) + ierr=nf_get_att_double(ncid,varid,'semi_minor_axis',rpol) + ierr=nf_get_att_double(ncid,varid,'perspective_point_height',pph) + ierr=nf_get_att_double(ncid,varid,'longitude_of_projection_origin',nam) + nam = nam * deg2rad + +!!! ierr=nf_inq_varid(ncid,'nominal_satellite_subpoint_lat',varid) +!!! ierr=nf_get_var_double(ncid,varid,lat_sat) +!!! ierr=nf_inq_varid(ncid,'nominal_satellite_subpoint_lon',varid) +!!! ierr=nf_get_var_double(ncid,varid,lon_sat) + + ierr=nf_close(ncid) + call handle_err('Error closing file',ierr) + + if (trace_use) call da_trace_exit("get_abil1b_metadata") + +end subroutine get_abil1b_metadata + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +subroutine get_abil1b_grid1( filename, & + ny, nx, & + yy_abi, xx_abi, & + yoff, xoff ) + + implicit none + + character(*), intent(in) :: filename + integer, intent(in) :: ny, nx + real, intent(out) :: yy_abi(ny), xx_abi(nx) + integer, intent(out) :: yoff, xoff + + integer :: ierr, ncid, varid + real :: slp, itp + + if (trace_use) call da_trace_entry("get_abil1b_grid1") + + ierr=nf_open(trim(filename),nf_nowrite,ncid) + call handle_err('Error opening file',ierr) + + ierr=nf_inq_varid(ncid,'y',varid) + + ierr=nf_get_var_double(ncid,varid,yy_abi) + + ierr=nf_get_att_double(ncid,varid,'scale_factor',slp) + ierr=nf_get_att_double(ncid,varid,'add_offset',itp) + yy_abi = yy_abi*slp+itp + yoff = floor(itp/slp) + + ierr=nf_inq_varid(ncid,'x',varid) + + ierr=nf_get_var_double(ncid,varid,xx_abi) + + ierr=nf_get_att_double(ncid,varid,'scale_factor',slp) + ierr=nf_get_att_double(ncid,varid,'add_offset',itp) + xx_abi = xx_abi*slp+itp + xoff = floor(itp/slp) + + ierr=nf_close(ncid) + call handle_err('Error closing file',ierr) + + if (trace_use) call da_trace_exit("get_abil1b_grid1") + +end subroutine get_abil1b_grid1 + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +subroutine get_abil1b_grid2_1d( yy_abi, xx_abi, req, rpol, pph, nam, satellite_id, & + lat, lon, satzen, satazi, & + earthmask, zenmask ) + + implicit none + + real, intent(in) :: yy_abi(:), xx_abi(:) + real(r_double), intent(in) :: req, rpol, pph, nam + integer, intent(in) :: satellite_id + + ! GOES-ABI fields + real, intent(out) :: lat(:), lon(:) + real, intent(out) :: satzen(:), satazi(:) + logical, intent(out) :: earthmask(:), zenmask(:) + + ! Internal Variables + type(info_type) :: info + logical :: outside_all, dummy_bool + + integer :: iy, ix, n + real(r_double) :: hh + real, parameter :: satzen_limit=75.0 + + if (trace_use) call da_trace_entry("get_abil1b_grid2_1d") + + lat = missing_r + lon = missing_r + satzen = missing_r + satazi = missing_r + earthmask=.true. + zenmask=.true. + + hh=pph+req + + call get_abil1b_latlon_1d ( yy_abi, xx_abi, lat, lon, req, rpol, hh, nam ) + + where( lat.eq.missing_r .OR. lon.eq.missing_r .OR. & + isnan(lat) .OR. isnan(lon) ) + earthmask = .false. + lat = missing_r + lon = missing_r + end where + + call da_get_sat_angles_1d( lat, lon, satellite_id, satzen, satazi ) + + where ( isnan(satzen) .or. satzen.gt.satzen_limit .or. satzen.eq.missing_r ) + satzen = missing_r + zenmask = .false. + end where + + if (trace_use) call da_trace_exit("get_abil1b_grid2_1d") + +end subroutine get_abil1b_grid2_1d + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +subroutine get_abil1b_rad( filename, ys, ye, xs, xe, radmask, inst, ichan, & + radout, bc1, bc2, fk1, fk2 ) + implicit none + + character(*), intent(in) :: filename + + !Size of full data set + + !Starting and stopping indices of this view desired (not equivalent to Full Disk indices) + integer, intent(in) :: ys, ye, xs, xe + integer, intent(in) :: inst, ichan + + logical, intent(inout) :: radmask( ys:ye, xs:xe ) + real, intent(out) :: radout( ys:ye, xs:xe ) + real, intent(out) :: bc1, bc2, fk1, fk2 + + real :: rad(xs:xe, ys:ye) + integer :: DQF(xs:xe, ys:ye) + + integer :: ierr, ncid, varid + integer :: iy, ix + integer :: nykeep, nxkeep + real :: slp, itp + + if (trace_use) call da_trace_entry("get_abil1b_rad") + + rad = missing_r + + !! Save rad reading time by selecting a subset of netcdf var + nykeep = ye - ys + 1 + nxkeep = xe - xs + 1 + + if (nykeep.le.0 .or. nxkeep.le.0) then + radmask = .false. + return + end if + + ierr=nf_open(trim(filename),nf_nowrite,ncid) + + call handle_err('Error opening file',ierr) + + ierr=nf_inq_varid( ncid, 'Rad', varid ) + ierr=nf_get_vara_double ( ncid, varid, (/xs,ys/), (/nxkeep,nykeep/), rad ) + ierr=nf_get_att_double(ncid,varid,'scale_factor',slp) + ierr=nf_get_att_double(ncid,varid,'add_offset',itp) + rad=rad*slp+itp + + ierr=nf_inq_varid ( ncid, 'DQF', varid ) + ierr=nf_get_vara_int ( ncid, varid, (/xs,ys/), (/nxkeep,nykeep/), DQF ) + + ierr=nf_inq_varid( ncid, 'planck_bc1', varid ) + ierr=nf_get_var_double( ncid, varid, bc1 ) + ierr=nf_inq_varid( ncid, 'planck_bc2', varid ) + ierr=nf_get_var_double( ncid, varid, bc2 ) + ierr=nf_inq_varid( ncid, 'planck_fk1', varid ) + ierr=nf_get_var_double( ncid, varid, fk1 ) + ierr=nf_inq_varid( ncid, 'planck_fk2', varid ) + ierr=nf_get_var_double( ncid, varid, fk2 ) + + radmask = ( radmask .and. (transpose(DQF).eq.0 .or. transpose(DQF).eq.1) ) + radmask = ( radmask .and. transpose(rad).gt.0.0 ) + + radout = missing_r + where ( radmask ) + radout = transpose(rad) + end where + + ierr=nf_close(ncid) + call handle_err('Error closing file',ierr) + + if (trace_use) call da_trace_exit("get_abil1b_rad") + +end subroutine get_abil1b_rad + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +elemental function rad2bt( rad, bc1, bc2, fk1, fk2 ) result(bt) + implicit none + + real, intent(in) :: rad + real, intent(in) :: bc1, bc2, fk1, fk2 + + real :: bt + + bt = ( fk2 / ( log(( fk1 / rad ) + 1.0) ) - bc1 ) / bc2 + +end function rad2bt + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +elemental function bt2rad( bt, bc1, bc2, fk1, fk2 ) result(rad) + implicit none + + real, intent(in) :: bt + real, intent(in) :: bc1, bc2, fk1, fk2 + + real :: rad + + rad = fk1 / ( exp( fk2 / (bc1 + bc2 * bt)) - 1.0 ) + +end function bt2rad + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +subroutine get_abil1b_terr( filename, ys, ye, xs, xe, terr ) + implicit none + + character(*), intent(in) :: filename + + !Size of full data set + + !Starting and stopping indices of this view desired (not equivalent to Full Disk indices) + integer, intent(in) :: ys, ye, xs, xe + real, intent(out) :: terr( ys:ye, xs:xe ) ! unit = meters + + real :: terr_trans( xs:xe, ys:ye ) ! unit = meters + integer :: ncid, varid + integer :: nykeep, nxkeep + real :: terr_miss + + if (trace_use) call da_trace_entry("get_abil1b_terr") + + terr = missing_r + + !! Save rad reading time by selecting a subset of netcdf var + nykeep = ye - ys + 1 + nxkeep = xe - xs + 1 + + if (nykeep.le.0 .or. nxkeep.le.0) then + return + end if + + call handle_err ( 'Error opening file', & + nf_open(trim(filename),nf_nowrite,ncid) ) + call handle_err ( 'Error getting terr ID', & + nf_inq_varid( ncid, 'terr', varid ) ) + + write(*,*) 'DEBUG get_abil1b_terr, xs, ys, xs+nxkeep, ys+nykeep: ',xs,ys,xs+nxkeep,ys+nykeep + + call handle_err ( 'Error reading terrain height', & + nf_get_vara_double ( ncid, varid, (/xs,ys/), (/nxkeep,nykeep/), terr_trans ) ) + terr = transpose(terr_trans) + + call handle_err ( 'Error with _FillValue', & + nf_get_att_double(ncid, varid, '_FillValue', terr_miss) ) + + where ( terr .le. terr_miss ) & + terr = missing_r + + call handle_err('Error closing file', & + nf_close(ncid) ) + + if (trace_use) call da_trace_exit("get_abil1b_terr") + +end subroutine get_abil1b_terr + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +subroutine get_abil1b_latlon_1d( yy_abi, xx_abi, lat, lon, req, rpol, hh, nam ) + + implicit none + + real, intent(in) :: yy_abi(:), xx_abi(:) + real, intent(in) :: req, rpol, hh, nam + real, intent(inout) :: lat(:), lon(:) + + real, allocatable :: lat1(:), lon1(:) + real, allocatable :: aa(:), bb(:), cc(:), rs(:), sx(:), sy(:), sz(:) + real, allocatable :: radicand(:) + integer :: n + + if (trace_use) call da_trace_entry("get_abil1b_latlon_1d") + + n = size(yy_abi) + + allocate ( lat1( n ) ) + allocate ( lon1( n ) ) + allocate ( aa( n ) ) + allocate ( bb( n ) ) + allocate ( cc( n ) ) + allocate ( rs( n ) ) + allocate ( sx( n ) ) + allocate ( sy( n ) ) + allocate ( sz( n ) ) + allocate ( radicand( n ) ) + + aa = sin( xx_abi )**2 + cos( xx_abi )**2 * ( cos( yy_abi )**2 + req**2/rpol**2 * sin( yy_abi )**2 ) + + bb = -2.D0 * hh * cos( xx_abi ) * cos( yy_abi ) + + cc = hh**2-req**2 + + radicand = bb ** 2 - 4.D0 * aa * cc + + where ( radicand .ge. 0. ) + rs = ( -bb - sqrt( radicand ) ) / ( 2.D0 * aa ) + sx = rs * cos( xx_abi ) * cos( yy_abi ) + sy = -rs * sin( xx_abi ) + sz = rs * cos( xx_abi ) * sin( yy_abi ) + + lat1 = atan( req**2 / rpol**2 * sz / sqrt( ( hh - sx )**2 + sy**2) ) + lon1 = nam - atan( sy / ( hh - sx ) ) + + lat = lat1 / deg2rad + lon = lon1 / deg2rad + end where + + deallocate ( lat1, lon1, aa, bb, cc, rs, sx, sy, sz, radicand ) + + if (trace_use) call da_trace_exit("get_abil1b_latlon_1d") + +end subroutine get_abil1b_latlon_1d + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +subroutine get_abil1b_latlon( yy_abi, xx_abi, lat, lon, req, rpol, hh, nam ) + + implicit none + + real, intent(in) :: yy_abi, xx_abi + real, intent(in) :: req, rpol, hh, nam + real, intent(inout) :: lat,lon + + real :: lat1,lon1 + real :: aa,bb,cc,rs,sx,sy,sz + real :: radicand + + if (trace_use) call da_trace_entry("get_abil1b_latlon") + + aa = sin( xx_abi )**2 + cos( xx_abi )**2 * ( cos( yy_abi )**2 + req**2/rpol**2 * sin( yy_abi )**2) + bb = -2.D0*hh * cos( xx_abi ) * cos( yy_abi ) + cc = hh**2 - req**2 + + radicand = bb **2 - 4.D0 * aa * cc + if (radicand .lt. 0.) return + + rs = ( -bb - sqrt( radicand ) )/(2.D0 * aa) + sx = rs * cos( xx_abi ) * cos( yy_abi ) + sy = -rs * sin( xx_abi ) + sz = rs * cos( xx_abi ) * sin( yy_abi ) + + lat1 = atan( req**2/rpol**2 * sz / sqrt( ( hh - sx )**2 + sy**2) ) + lon1 = nam-atan( sy / ( hh - sx ) ) + + lat = lat1 / deg2rad + lon = lon1 / deg2rad + + if (trace_use) call da_trace_exit("get_abil1b_latlon") + +end subroutine get_abil1b_latlon + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +#ifdef DM_PARALLEL +subroutine split_grid( ny_global, nx_global, & + ny_grid, nx_grid, & + ys_grid, xs_grid ) + implicit none + + integer, intent(in) :: ny_global, nx_global + integer, intent(out) :: ny_grid(num_procs), nx_grid(num_procs), & + ys_grid(num_procs), xs_grid(num_procs) + + integer, target :: ny_vec(ntasks_y), ys_vec(ntasks_y) !, ye_vec(ntasks_y) + integer, target :: nx_vec(ntasks_x), xs_vec(ntasks_x) !, xe_vec(ntasks_x) + integer, pointer :: nvec(:), svec(:) + + integer :: mm, i, j, ii, iproc, igrid, ntasks, nglobal, fact + + do igrid = 1, 2 + if (igrid.eq.1) then + nvec => ny_vec + svec => ys_vec + ntasks = ntasks_y + nglobal = ny_global + else if (igrid.eq.2) then + nvec => nx_vec + svec => xs_vec + ntasks = ntasks_x + nglobal = nx_global + end if + + nvec = nglobal / ntasks + mm = mod( nglobal , ntasks ) + do j = 1, ntasks + if ( mm .eq. 0 ) exit + nvec(j) = nvec(j) + 1 + mm = mm - 1 + end do + + svec(1) = 1 + do j = 1, ntasks + if (j .lt. ntasks) then + svec(j+1) = svec(j) + nvec(j) + end if + end do + end do + + iproc = 0 + do j = 1, ntasks_y + do i = 1, ntasks_x + iproc = iproc + 1 + ny_grid(iproc) = ny_vec(j) + ys_grid(iproc) = ys_vec(j) + nx_grid(iproc) = nx_vec(i) + xs_grid(iproc) = xs_vec(i) + end do + end do + +end subroutine split_grid +#endif + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +subroutine jday2cal(jdy, yr, mt, dy) + implicit none + integer, intent(in) :: jdy, yr + integer, intent(out) :: mt, dy + integer :: d_in_m(12) = (/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/) + integer :: imonth, tot_days + if ( mod(yr,4).eq.0 .and. .not.(mod(yr,100).eq.0 .and. .not.mod(yr,400).eq.0) ) d_in_m(2) = 29 + tot_days = 0 + do imonth = 1, 12 + tot_days = tot_days + d_in_m(imonth) + if (tot_days .ge. jdy) then + mt = imonth + dy = jdy - ( tot_days - d_in_m(imonth) ) + exit + end if + end do +end subroutine jday2cal + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +subroutine da_get_cal_time(jmod,yr,mt,dy,hr,mn,sc) + ! Converts modified Julian time (in minutes) to Gregorian calender date + ! Modified from this code: David G. Simpson, NASA Goddard, Accessed April 2018 + ! https://caps.gsfc.nasa.gov/simpson/software.html + + implicit none + + real(r_double), intent(in) :: jmod + integer, intent(out) :: yr,mt,dy,hr,mn + integer, intent(out), optional :: sc + + real(r_double) :: ju, j0, F + integer :: yr0, sc0 + INTEGER :: A, B, C, D, E, Z, ALPHA ! intermediate variables + real(r_double) :: dd + + ! Conversion to Julian day from MJD reference time: 1978 Jan 01 00:12:00 (see da_get_julian_time) + real(r_double), parameter :: jd_jmod = 2443510.0 + + ! Convert to days + ju = jmod / 1440.D0 + + !! Convert reference MJD to actual Julian time + ju = ju+jd_jmod + Z = INT(ju) + F = ju - Z + + !! Gregorian date test (can probably assume this is a Gregorian date) + IF (Z .LT. 2299161) THEN + A = Z + ELSE + ALPHA = INT((Z-1867216.25D0)/36524.25D0) + A = Z + 1 + ALPHA - ALPHA/4 + END IF + + B = A + 1524 + C = INT((B-122.1D0)/365.25D0) + D = INT(365.25D0*C) + E = INT((B-D)/30.6001D0) + + IF (E .LT. 14) THEN + mt = E - 1 + ELSE + mt = E - 13 + END IF + + IF (mt .GT. 2) THEN + yr = C - 4716 + ELSE + yr = C - 4715 + END IF + + dd = B - D - INT(30.6001D0*E) + F + + dy = floor(dd) + + !! Remainder for hr, mn, sc. + dd = dd - real(dy,8) + + sc0 = nint(dd*86400.) + hr = sc0 / 3600 + sc0 = sc0 - hr*3600 + mn = sc0 / 60 + if (present(sc)) sc = sc0 - mn*60 + +end subroutine da_get_cal_time + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +subroutine handle_err(rmarker,nf_status) + implicit none + integer, intent(in) :: nf_status + character*(*), intent(in) :: rmarker + if (nf_status .ne. nf_noerr) then + write(*,*) 'NetCDF error : ',rmarker + write(*,*) ' ',nf_strerror(nf_status) + stop + endif +end subroutine handle_err + diff --git a/var/da/da_radiance/da_rttov.f90 b/var/da/da_radiance/da_rttov.f90 index 46e71c55b5..9bad0db61f 100644 --- a/var/da/da_radiance/da_rttov.f90 +++ b/var/da/da_radiance/da_rttov.f90 @@ -31,9 +31,11 @@ module da_rttov num_fgat_time,stdout,trace_use, use_error_factor_rad, & qc_good, qc_bad,myproc,biascorr, global,ims,ime,jms,jme, & use_clddet, time_slots, rttov_emis_atlas_ir, rttov_emis_atlas_mw, & - use_mspps_emis, use_mspps_ts + use_mspps_emis, use_mspps_ts, use_clddet_zz use da_interpolation, only : da_to_zk_new, & - da_interp_lin_2d, da_interp_lin_3d, da_interp_lin_3d_adj, da_interp_lin_2d_adj + da_interp_lin_2d, da_interp_lin_3d, da_interp_lin_3d_adj, da_interp_lin_2d_adj, & + da_interp_2d_partial + use da_physics, only: da_trop_wmo use da_tools_serial, only : da_get_unit, da_free_unit #ifdef DM_PARALLEL use da_par_util, only : true_mpi_real diff --git a/var/da/da_radiance/da_setup_radiance_structures.inc b/var/da/da_radiance/da_setup_radiance_structures.inc index cdf9f9238b..10f5f1c724 100644 --- a/var/da/da_radiance/da_setup_radiance_structures.inc +++ b/var/da/da_radiance/da_setup_radiance_structures.inc @@ -217,6 +217,13 @@ subroutine da_setup_radiance_structures( grid, ob, iv ) !end if !write(unit=stdout,fmt='(a)') 'Finish reading goesimg data' end if + if (use_goesabiobs) then + write(unit=stdout,fmt='(a)') 'Reading netcdf goes ABI radiance data' + + call da_read_obs_ncgoesabi(iv, 16) + + call da_read_obs_ncgoesabi(iv, 17) + end if if (use_gmiobs) then #if defined(HDF5) write(unit=stdout,fmt='(a)') 'Reading GMI data in HDF5 format' diff --git a/var/da/da_radiance/da_write_iv_rad_ascii.inc b/var/da/da_radiance/da_write_iv_rad_ascii.inc index c5a6fa84dd..efb3b2874c 100644 --- a/var/da/da_radiance/da_write_iv_rad_ascii.inc +++ b/var/da/da_radiance/da_write_iv_rad_ascii.inc @@ -18,7 +18,7 @@ subroutine da_write_iv_rad_ascii (it, ob, iv ) character(len=filename_len) :: filename character(len=7) :: surftype integer :: ndomain - logical :: amsr2, ahi + logical :: amsr2, ahi, abi real :: cip ! to output cloud-ice path integer :: cloudflag ! to output cloudflag integer, dimension(1) :: maxl @@ -59,6 +59,7 @@ subroutine da_write_iv_rad_ascii (it, ob, iv ) endif amsr2 = index(iv%instid(i)%rttovid_string,'amsr2') > 0 + abi = index(iv%instid(i)%rttovid_string,'abi') > 0 ahi = index(iv%instid(i)%rttovid_string,'ahi') > 0 write(unit=filename, fmt='(i2.2,a,i4.4)') it,'_inv_'//trim(iv%instid(i)%rttovid_string)//'.', myproc @@ -177,7 +178,7 @@ subroutine da_write_iv_rad_ascii (it, ob, iv ) write(unit=innov_rad_unit,fmt='(10f11.2)') ob%instid(i)%tb(:,n) write(unit=innov_rad_unit,fmt='(a)') 'BAK : ' write(unit=innov_rad_unit,fmt='(10f11.2)') iv%instid(i)%tb_xb(:,n) - if (rtm_option==rtm_option_crtm .and. crtm_cloud .and. (amsr2 .or. ahi) ) then + if (rtm_option==rtm_option_crtm .and. crtm_cloud .and. (amsr2 .or. ahi .or. abi) ) then write(unit=innov_rad_unit,fmt='(a)') 'BAK_clr : ' write(unit=innov_rad_unit,fmt='(10f11.2)') iv%instid(i)%tb_xb_clr(:,n) endif @@ -197,6 +198,14 @@ subroutine da_write_iv_rad_ascii (it, ob, iv ) write(unit=innov_rad_unit,fmt='(10f11.2)') iv%instid(i)%tb_error(:,n) write(unit=innov_rad_unit,fmt='(a)') 'QC : ' write(unit=innov_rad_unit,fmt='(10i11)') iv%instid(i)%tb_qc(:,n) + if ( abi .and. crtm_cloud ) then ! write out cloud_mod, cloud_obs + write(unit=innov_rad_unit,fmt='(a)') 'CMOD : ' + write(unit=innov_rad_unit,fmt='(10f11.2)') iv%instid(i)%cloud_mod(:,n) + write(unit=innov_rad_unit,fmt='(a)') 'COBS : ' + write(unit=innov_rad_unit,fmt='(10f11.2)') iv%instid(i)%cloud_obs(:,n) + write(unit=innov_rad_unit,fmt='(a)') 'CLOUD : ' + write(unit=innov_rad_unit,fmt='(10i11)') iv%instid(i)%cloud_flag(:,n) + end if if (write_profile) then nlevelss = iv%instid(i)%nlevels diff --git a/var/da/da_radiance/da_write_oa_rad_ascii.inc b/var/da/da_radiance/da_write_oa_rad_ascii.inc index 2f058839df..613cbcf4c5 100644 --- a/var/da/da_radiance/da_write_oa_rad_ascii.inc +++ b/var/da/da_radiance/da_write_oa_rad_ascii.inc @@ -19,7 +19,7 @@ subroutine da_write_oa_rad_ascii (it, ob, iv, re ) character(len=filename_len) :: filename character(len=7) :: surftype integer :: ndomain - logical :: amsr2 + logical :: amsr2, abi if (trace_use) call da_trace_entry("da_write_oa_rad_ascii") @@ -40,6 +40,7 @@ subroutine da_write_oa_rad_ascii (it, ob, iv, re ) if (ndomain < 1) cycle amsr2 = index(iv%instid(i)%rttovid_string,'amsr2') > 0 + abi = index(iv%instid(i)%rttovid_string,'abi') > 0 write(unit=filename, fmt='(i2.2,a,i4.4)') it,'_oma_'//trim(iv%instid(i)%rttovid_string)//'.', myproc @@ -141,6 +142,14 @@ subroutine da_write_oa_rad_ascii (it, ob, iv, re ) write(unit=oma_rad_unit,fmt='(10f11.2)') iv%instid(i)%tb_error(:,n) write(unit=oma_rad_unit,fmt='(a)') 'QC : ' write(unit=oma_rad_unit,fmt='(10i11)') iv%instid(i)%tb_qc(:,n) + if ( abi .and. crtm_cloud ) then ! write out cloud_mod, cloud_obs, cloud_flag + write(unit=oma_rad_unit,fmt='(a)') 'CMOD : ' + write(unit=oma_rad_unit,fmt='(10f11.2)') iv%instid(i)%cloud_mod(:,n) + write(unit=oma_rad_unit,fmt='(a)') 'COBS : ' + write(unit=oma_rad_unit,fmt='(10f11.2)') iv%instid(i)%cloud_obs(:,n) + write(unit=oma_rad_unit,fmt='(a)') 'CLOUD : ' + write(unit=oma_rad_unit,fmt='(10i11)') iv%instid(i)%cloud_flag(:,n) + end if if (write_profile) then nlevelss = iv%instid(i)%nlevels diff --git a/var/da/da_radiance/module_radiance.f90 b/var/da/da_radiance/module_radiance.f90 index 2fbfdd0a9c..ba3ad3f581 100644 --- a/var/da/da_radiance/module_radiance.f90 +++ b/var/da/da_radiance/module_radiance.f90 @@ -161,6 +161,8 @@ module module_radiance integer, pointer :: iuse (:) ! usage flag (-1: not use) from radiance info file real , pointer :: error(:) ! error Standard Deviation from radiance info file real , pointer :: error_cld(:) ! error Standard Deviation for cloudy radiance from radiance info file + real , pointer :: error_cld_y(:) ! error Standard Deviation for cloudy radiance from radiance info file, for ABI + real , pointer :: error_cld_x(:) ! error Standard Deviation for cloudy radiance from radiance info file, for ABI real , pointer :: polar(:) ! polarisation (0:ver; 1:hori) from radiance info file real , pointer :: error_factor(:) ! error tuning factor ! from error tuning file ! new air mass bias correction coefs. diff --git a/var/da/da_setup_structures/da_setup_obs_structures.inc b/var/da/da_setup_structures/da_setup_obs_structures.inc index 76573c9647..e627396308 100644 --- a/var/da/da_setup_structures/da_setup_obs_structures.inc +++ b/var/da/da_setup_structures/da_setup_obs_structures.inc @@ -67,6 +67,10 @@ subroutine da_setup_obs_structures( grid, ob, iv, j_cost) use_airsobs = .false. use_eos_amsuaobs = .false. use_hsbobs = .false. + use_ahiobs = .false. + use_mwhs2obs = .false. + use_gmiobs = .false. + use_goesabiobs = .false. use_obsgts = .false. use_rad = .false. use_airsretobs = .false. @@ -103,7 +107,7 @@ subroutine da_setup_obs_structures( grid, ob, iv, j_cost) use_ssmisobs .OR. use_hirs4obs .OR. use_mhsobs .OR. use_pseudo_rad .OR. & use_mwtsobs .OR. use_mwhsobs .OR. use_atmsobs .OR. use_simulated_rad .OR. & use_iasiobs .OR. use_seviriobs .OR. use_amsr2obs .OR. use_goesimgobs .OR. & - use_ahiobs .OR. use_mwhs2obs .OR. use_gmiobs) then + use_ahiobs .OR. use_mwhs2obs .OR. use_gmiobs .OR. use_goesabiobs) then use_rad = .true. else use_rad = .false. @@ -154,6 +158,10 @@ subroutine da_setup_obs_structures( grid, ob, iv, j_cost) use_airsobs = .false. use_eos_amsuaobs = .false. use_hsbobs = .false. + use_ahiobs = .false. + use_mwhs2obs = .false. + use_gmiobs = .false. + use_goesabiobs = .false. use_obsgts = .false. use_rad = .false. use_airsretobs = .false. @@ -427,6 +435,15 @@ subroutine da_setup_obs_structures( grid, ob, iv, j_cost) if ( use_amsr2obs ) then call da_message((/'Using AMSR2 radiance input in HDF5 format'/)) end if + if ( use_goesimgobs ) then + call da_message((/'Using GOES IMAGER radiance input in netcdf format'/)) + end if + if ( use_goesabiobs ) then + call da_message((/'Using GOES ABI radiance input in netcdf format'/)) + end if + if ( use_ahiobs ) then + call da_message((/'Using himawari AHI radiance input in netcdf format'/)) + end if if ( use_gmiobs ) then call da_message((/'Using GMI radiance input in HDF5 format'/)) end if diff --git a/var/da/da_setup_structures/da_setup_structures.f90 b/var/da/da_setup_structures/da_setup_structures.f90 index 22997feacc..c94e5daf06 100644 --- a/var/da/da_setup_structures/da_setup_structures.f90 +++ b/var/da/da_setup_structures/da_setup_structures.f90 @@ -74,7 +74,7 @@ module da_setup_structures chi_u_t_factor, chi_u_ps_factor,chi_u_rh_factor, t_u_rh_factor, ps_u_rh_factor, & interpolate_stats, be_eta, thin_rainobs, fgat_rain_flags, use_iasiobs, & use_seviriobs, jds_int, jde_int, anal_type_hybrid_dual_res, use_amsr2obs, nrange, use_4denvar, & - use_goesimgobs, use_ahiobs,use_gmiobs, obs_use, thin_conv_opt, no_thin, & + use_goesimgobs, use_ahiobs, use_goesabiobs, use_gmiobs, obs_use, thin_conv_opt, no_thin, & thin_superob_hv, thin_mesh_vert_conv, use_satwnd_bufr use da_control, only: rden_bin, use_lsac use da_control, only: use_cv_w diff --git a/var/da/da_tools/da_llxy_1d.inc b/var/da/da_tools/da_llxy_1d.inc new file mode 100644 index 0000000000..0752830bc3 --- /dev/null +++ b/var/da/da_tools/da_llxy_1d.inc @@ -0,0 +1,115 @@ +subroutine da_llxy_1d ( infos, locs, outside, outside_all, do_xy, do_outside) + + !----------------------------------------------------------------------- + ! Purpose: TBD + ! Author: JJ Guerrette, MMM/NCAR, Date: 05/23/2018 + ! Modified from da_llxy, including child subroutines + !----------------------------------------------------------------------- + + ! This routine converts (lat, lon) into (x,y) coordinates + + implicit none + + type(info_type), optional, intent(in) :: infos(:) + type(model_loc_type), intent(inout) :: locs(:) + logical , intent(out) :: outside(:) !wrt local domain + logical, optional, intent(out) :: outside_all(:) !wrt all domains + logical, optional, intent(in) :: do_xy, do_outside + logical :: do_xy_, do_outside_ + + if (trace_use) call da_trace_entry("da_llxy_1d") + + outside = .false. + + do_xy_ = .true. + if ( present(do_xy) ) do_xy_ = do_xy + if ( do_xy_ ) then + if (present(infos)) then + locs(:) % x = -1.0 + locs(:) % y = -1.0 + + ! get the (x, y) coordinates + if ( fg_format == fg_format_wrf_arw_regional ) then + call da_llxy_wrf_1d(map_info, infos(:)%lat, infos(:)%lon, locs(:)%x, locs(:)%y) + else if (fg_format == fg_format_wrf_nmm_regional) then + call da_llxy_rotated_latlon_1d(infos(:)%lat, infos(:)%lon, map_info, locs(:)%x, locs(:)%y) + else if (global) then + call da_llxy_global_1d (infos(:)%lat, infos(:)%lon, locs(:)%x, locs(:)%y) + else + call da_llxy_default_1d (infos(:)%lat, infos(:)%lon, locs(:)%x, locs(:)%y) + end if + else + message(1)='da_llxy_1d requires infos in order to determine x & y' + call da_error(__FILE__,__LINE__,message(1:1)) + end if + end if + +#ifdef A2C + call da_togrid_1d (locs(:)%x, its-3, ite+3, locs(:)%i, locs(:)%dx, locs(:)%dxm)! + + call da_togrid_1d (locs(:)%y, jts-3, jte+3, locs(:)%j, locs(:)%dy, locs(:)%dym) +#else + call da_togrid_1d (locs(:)%x, its-2, ite+2, locs(:)%i, locs(:)%dx, locs(:)%dxm)! + + call da_togrid_1d (locs(:)%y, jts-2, jte+2, locs(:)%j, locs(:)%dy, locs(:)%dym) +#endif + +! do_outside_ = .true. +! if ( present(do_outside) ) do_outside_ = do_outside +! if ( .not.do_outside_ ) return + + ! refactor to remove this ugly duplication later + if (present(outside_all)) then + outside_all(:) = .false. + ! Do not check for global options + if (.not. global) then + outside_all = outside_all .or. & + (int(locs(:)%x) < ids) .or. (int(locs(:)%x) >= ide) .or. & + (int(locs(:)%y) < jds) .or. (int(locs(:)%y) >= jde) + outside = outside .or. outside_all + if (def_sub_domain) then + outside_all = outside_all .or. & + x_start_sub_domain > locs(:)%x .or. y_start_sub_domain > locs(:)%y .or. & + x_end_sub_domain < locs(:)%x .or. y_end_sub_domain < locs(:)%y + outside = outside .or. outside_all + end if + end if + end if + + if (fg_format == fg_format_kma_global) then + outside = outside .or. & + (locs(:)%j < jts-1) .or. (locs(:)%j > jte) + + where (locs(:)%j == jde) + locs%j = locs%j - 1 + locs%dy = 1.0 + locs%dym = 0.0 + end where + + return + end if + + ! Check for edge of domain: + outside = outside .or. & + (locs(:)%i < ids) .or. (locs(:)%i >= ide) .or. & + (locs(:)%j < jds) .or. (locs(:)%j >= jde) + + ! FIX? hack + outside = outside .or. & +#ifdef A2C + (locs(:)%i < its-2) .or. (locs(:)%i > ite) .or. & + (locs(:)%j < jts-2) .or. (locs(:)%j > jte) +#else + (locs(:)%i < its-1) .or. (locs(:)%i > ite) .or. & + (locs(:)%j < jts-1) .or. (locs(:)%j > jte) +#endif + + if (def_sub_domain) then + outside = outside .or. & + x_start_sub_domain > locs(:)%x .or. y_start_sub_domain > locs(:)%y .or. & + x_end_sub_domain < locs(:)%x .or. y_end_sub_domain < locs(:)%y + end if + + if (trace_use) call da_trace_exit("da_llxy_1d") + +end subroutine da_llxy_1d diff --git a/var/da/da_tools/da_llxy_default_1d.inc b/var/da/da_tools/da_llxy_default_1d.inc new file mode 100644 index 0000000000..011a9d8b74 --- /dev/null +++ b/var/da/da_tools/da_llxy_default_1d.inc @@ -0,0 +1,114 @@ +subroutine da_llxy_default_1d (xlati,xloni,x,y) + + !---------------------------------------------------------------------------- + ! Purpose: calculates the (x,y) location (dot) in the mesoscale grids + ! ------- from latitudes and longitudes + ! + ! for global domain co-ordinates + ! + ! input: + ! ----- + ! xlat: latitudes + ! xlon: longitudes + ! + ! output: + ! ----- + ! x: the coordinate in x (i)-direction. + ! y: the coordinate in y (j)-direction. + ! + !---------------------------------------------------------------------------- + + implicit none + + real, intent(in) :: xlati(:), xloni(:) + real, intent(out) :: x(:), y(:) + + real, allocatable :: dxlon(:) + real, allocatable :: xlat(:), xlon(:) + real, allocatable :: xx(:), yy(:), cell(:), psx(:), r(:), flp(:) + real :: xc, yc + real :: psi0 + real :: centri, centrj + real :: ratio + real :: bb + real, parameter :: conv = 180.0 / pi + integer :: n + + if (trace_use_frequent) call da_trace_entry("da_llxy_default_1d") + + n = size(xlati) + allocate ( dxlon(n), xlat(n), xlon(n), xx(n), yy(n), cell(n), psx(n), r(n), flp(n) ) + + xlon = xloni + xlat = xlati + + where (xlat .lt. -89.95) xlat = -89.95 + where (xlat .gt. +89.95) xlat = +89.95 + + dxlon = xlon - xlonc + where (dxlon > 180) dxlon = dxlon - 360.0 + where (dxlon < -180) dxlon = dxlon + 360.0 + + if (map_projection == 3) then + xc = 0.0 + yc = YCNTR + + cell = cos(xlat/conv)/(1.0+sin(xlat/conv)) + yy = -c2*alog(cell) + xx = c2*dxlon/conv + else + psi0 = (pole - phic)/conv + xc = 0.0 + + ! calculate x,y coords. relative to pole + + flp = cone_factor*dxlon/conv + + psx = (pole - xlat)/conv + + if (map_projection == 2) then + ! Polar stereographics: + bb = 2.0*(cos(psi1/2.0)**2) + yc = -earth_radius*bb*tan(psi0/2.0) + r = -earth_radius*bb*tan(psx/2.0) + else + ! Lambert conformal: + bb = -earth_radius/cone_factor*sin(psi1) + yc = bb*(tan(psi0/2.0)/tan(psi1/2.0))**cone_factor + r = bb*(tan(psx /2.0)/tan(psi1/2.0))**cone_factor + end if + + if (phic < 0.0) then + xx = r*sin(flp) + yy = r*cos(flp) + else + xx = -r*sin(flp) + yy = r*cos(flp) + end if + end if + + ! transform (1,1) to the origin + ! the location of the center in the coarse domain + + centri = real (coarse_ix + 1)/2.0 + centrj = real (coarse_jy + 1)/2.0 + + ! the (x,y) coordinates in the coarse domain + + x = (xx - xc)/coarse_ds + centri + y = (yy - yc)/coarse_ds + centrj + + ratio = coarse_ds / dsm + + ! only add 0.5 so that x/y is relative to first cross points: + + x = (x - start_x) * ratio + 0.5 + y = (y - start_y) * ratio + 0.5 + + deallocate ( dxlon, xlat, xlon, xx, yy, cell, psx, r, flp ) + + if (trace_use_frequent) call da_trace_exit("da_llxy_default_1d") + +end subroutine da_llxy_default_1d + + diff --git a/var/da/da_tools/da_llxy_global_1d.inc b/var/da/da_tools/da_llxy_global_1d.inc new file mode 100644 index 0000000000..9565be5cf5 --- /dev/null +++ b/var/da/da_tools/da_llxy_global_1d.inc @@ -0,0 +1,35 @@ +subroutine da_llxy_global_1d(lat,lon,x,y) + + !---------------------------------------------------------------------------- + ! Purpose: calculates the(x,y) location(dot) in the global grids + ! from latitudes and longitudes + !---------------------------------------------------------------------------- + + implicit none + + real, intent(in) :: lat(:), lon(:) + real, intent(out) :: x(:), y(:) + + real, allocatable :: xlat(:), xlon(:) + integer :: n + + if (trace_use_frequent) call da_trace_entry("da_llxy_global_1d") + + n = size(lat) + allocate ( xlat(n), xlon(n) ) + + xlat = lat - start_lat + xlon = lon - start_lon + where (xlat < 0.0) xlat = xlat + 180.0 + where (xlon < 0.0) xlon = xlon + 360.0 + + x = start_x + xlon/delt_lon + y = start_y + xlat/delt_lat + if(fg_format == fg_format_wrf_arw_global) & + where (lat.le.start_lat) y = 1.0 + + deallocate ( xlat, xlon ) + + if (trace_use_frequent) call da_trace_exit("da_llxy_global_1d") + +end subroutine da_llxy_global_1d diff --git a/var/da/da_tools/da_llxy_kma_global_1d.inc b/var/da/da_tools/da_llxy_kma_global_1d.inc new file mode 100644 index 0000000000..cac3245601 --- /dev/null +++ b/var/da/da_tools/da_llxy_kma_global_1d.inc @@ -0,0 +1,36 @@ +subroutine da_llxy_kma_global_1d(lat,lon,x,y) + + !---------------------------------------------------------------------------- + ! Purpose: calculates the(x,y) location(dot) in the global grids + ! from latitudes and longitudes + !---------------------------------------------------------------------------- + + implicit none + + real, intent(in) :: lat(:), lon(:) + real, intent(out) :: x(:), y(:) + + real, allocatable :: xlat(:), xlon(:) + integer :: n + + if (trace_use_frequent) call da_trace_entry("da_llxy_kma_global_1d") + + n = size(lat) + allocate ( xlat(n), xlon(n) ) + + xlat = lat - start_lat + xlon = lon - start_lon + + where (xlat < 0.0) xlat = xlat + 180.0 + where (xlon < 0.0) xlon = xlon + 360.0 + + x = start_x + xlon/delt_lon + y = start_y + xlat/delt_lat + + deallocate ( xlat, xlon ) + + if (trace_use_frequent) call da_trace_exit("da_llxy_kma_global_1d") + +end subroutine da_llxy_kma_global_1d + + diff --git a/var/da/da_tools/da_llxy_latlon_1d.inc b/var/da/da_tools/da_llxy_latlon_1d.inc new file mode 100644 index 0000000000..0b9e869ed9 --- /dev/null +++ b/var/da/da_tools/da_llxy_latlon_1d.inc @@ -0,0 +1,56 @@ +subroutine da_llxy_latlon_1d(lat, lon, proj, x, y) + + !----------------------------------------------------------------------- + ! Purpose: Compute the x/y location of a lat/lon on a LATLON + ! (cylindrical equidistant) grid. + !----------------------------------------------------------------------- + + implicit none + + real, intent(in) :: lat(:) + real, intent(in) :: lon(:) + type(proj_info), intent(in) :: proj + real, intent(out) :: x(:) + real, intent(out) :: y(:) + + real, allocatable :: deltalat(:) + real, allocatable :: deltalon(:) + real, allocatable :: lon360(:) + real :: latinc + real :: loninc + integer :: n + + if (trace_use_frequent) call da_trace_entry("da_llxy_latlon_1d") + + n = size(lat) + allocate ( deltalat(n), deltalon(n), lon360(n) ) + + ! To account for issues around the dateline, convert the incoming + ! longitudes to be 0->360.0 + where (lon < 0) + lon360 = lon + 360.0 + elsewhere + lon360 = lon + end where + + deltalat = lat - proj%lat1 + deltalon = lon360 - proj%lon1 + + !For cylindrical equidistant, dx == dy + loninc = proj%dx*360.0/(2.0*EARTH_RADIUS_M*PI) + latinc = proj%dx*360.0/(2.0*EARTH_RADIUS_M*PI) + + ! Compute x/y + x = deltalon/loninc + y = deltalat/latinc + + x = x + proj%knowni + y = y + proj%knownj + + deallocate ( deltalat, deltalon, lon360 ) + + if (trace_use_frequent) call da_trace_exit("da_llxy_latlon_1d") + +end subroutine da_llxy_latlon_1d + + diff --git a/var/da/da_tools/da_llxy_lc_1d.inc b/var/da/da_tools/da_llxy_lc_1d.inc new file mode 100644 index 0000000000..b56e07b789 --- /dev/null +++ b/var/da/da_tools/da_llxy_lc_1d.inc @@ -0,0 +1,64 @@ +subroutine da_llxy_lc_1d(lat, lon, proj, x, y) + + !----------------------------------------------------------------------- + ! Purpose: compute the geographical latitude and longitude values + ! to the cartesian x/y on a Lambert Conformal projection. + !----------------------------------------------------------------------- + + implicit none + + real, intent(in) :: lat(:) ! Latitude (-90->90 deg N) + real, intent(in) :: lon(:) ! Longitude (-180->180 E) + type(proj_info),intent(in) :: proj ! Projection info structure + + real, intent(out) :: x(:) ! Cartesian X coordinate + real, intent(out) :: y(:) ! Cartesian Y coordinate + + real, allocatable :: arg(:) + real, allocatable :: deltalon(:) + real :: tl1r + real, allocatable :: rm(:) + real :: ctl1r + integer :: n + + if (trace_use_dull) call da_trace_entry("da_llxy_lc_1d") + + n = size(lat) + allocate ( arg(n), deltalon(n), rm(n) ) + + ! Compute deltalon between known longitude and standard lon and ensure + ! it is not in the cut zone + deltalon = lon - proj%stdlon + where (deltalon > +180.0) deltalon = deltalon - 360.0 + where (deltalon < -180.0) deltalon = deltalon + 360.0 + + ! Convert truelat1 to radian and compute COS for later use + tl1r = proj%truelat1 * rad_per_deg + ctl1r = COS(tl1r) + + ! Radius to desired point + rm = proj%rebydx * ctl1r/proj%cone * & + (TAN((90.0*proj%hemi-lat)*rad_per_deg/2.0) / & + TAN((90.0*proj%hemi-proj%truelat1)*rad_per_deg/2.0))**proj%cone + + arg = proj%cone*(deltalon*rad_per_deg) + x = proj%polei + proj%hemi * rm * Sin(arg) + y = proj%polej - rm * COS(arg) + + ! Finally, if we are in the southern hemisphere, flip the i/j + ! values to a coordinate system where (1,1) is the SW corner + ! (what we assume) which is different than the original NCEP + ! algorithms which used the NE corner as the origin in the + ! southern hemisphere (left-hand vs. right-hand coordinate?) + if (proj%hemi == -1.0) then + x = 2.0 - x + y = 2.0 - y + end if + + deallocate ( arg, deltalon, rm ) + + if (trace_use_dull) call da_trace_exit("da_llxy_lc_1d") + +end subroutine da_llxy_lc_1d + + diff --git a/var/da/da_tools/da_llxy_merc_1d.inc b/var/da/da_tools/da_llxy_merc_1d.inc new file mode 100644 index 0000000000..ef39acf721 --- /dev/null +++ b/var/da/da_tools/da_llxy_merc_1d.inc @@ -0,0 +1,35 @@ +subroutine da_llxy_merc_1d(lat, lon, proj, x, y) + + !----------------------------------------------------------------------- + ! Purpose: Compute x,y coordinate from lat lon for mercator projection + !----------------------------------------------------------------------- + + implicit none + + real, intent(in) :: lat(:) + real, intent(in) :: lon(:) + type(proj_info),intent(in) :: proj + real,intent(out) :: x(:) + real,intent(out) :: y(:) + real, allocatable :: deltalon(:) + integer :: n + + if (trace_use_frequent) call da_trace_entry("da_llxy_merc_1d") + + n = size(lat) + allocate ( deltalon(n) ) + + deltalon = lon - proj%lon1 + where (deltalon < -180.0) deltalon = deltalon + 360.0 + where (deltalon > 180.0) deltalon = deltalon - 360.0 + x = 1.0 + (deltalon/(proj%dlon*deg_per_rad)) + y = 1.0 + (ALOG(TAN(0.5*((lat + 90.0) * rad_per_deg)))) / & + proj%dlon - proj%rsw + + deallocate ( deltalon ) + + if (trace_use_frequent) call da_trace_exit("da_llxy_merc_1d") + +end subroutine da_llxy_merc_1d + + diff --git a/var/da/da_tools/da_llxy_ps_1d.inc b/var/da/da_tools/da_llxy_ps_1d.inc new file mode 100644 index 0000000000..3c39cfb9fb --- /dev/null +++ b/var/da/da_tools/da_llxy_ps_1d.inc @@ -0,0 +1,50 @@ +subroutine da_llxy_ps_1d(lat,lon,proj,x,y) + + !----------------------------------------------------------------------- + ! Purpose: Given latitude (-90 to 90), longitude (-180 to 180), and the + ! standard polar-stereographic projection information via the + ! public proj structure, this routine returns the x/y indices which + ! if within the domain range from 1->nx and 1->ny, respectively. + !----------------------------------------------------------------------- + + implicit none + + real, intent(in) :: lat(:) + real, intent(in) :: lon(:) + type(proj_info),intent(in) :: proj + + real, intent(out) :: x(:) !(x-index) + real, intent(out) :: y(:) !(y-index) + + real :: reflon + real :: scale_top + real, allocatable :: ala(:) + real, allocatable :: alo(:) + real, allocatable :: rm(:) + integer :: n + + if (trace_use_frequent) call da_trace_entry("da_llxy_ps_1d") + + reflon = proj%stdlon + 90.0 + + ! Compute numerator term of map scale factor + + scale_top = 1.0 + proj%hemi * Sin(proj%truelat1 * rad_per_deg) + + ! Find radius to desired point + n = size(lat) + allocate ( ala(n), alo(n), rm(n) ) + + ala = lat * rad_per_deg + rm = proj%rebydx * COS(ala) * scale_top/(1.0 + proj%hemi *Sin(ala)) + alo = (lon - reflon) * rad_per_deg + x = proj%polei + rm * COS(alo) + y = proj%polej + proj%hemi * rm * Sin(alo) + + deallocate ( ala, alo, rm ) + + if (trace_use_frequent) call da_trace_exit("da_llxy_ps_1d") + +end subroutine da_llxy_ps_1d + + diff --git a/var/da/da_tools/da_llxy_rotated_latlon_1d.inc b/var/da/da_tools/da_llxy_rotated_latlon_1d.inc new file mode 100644 index 0000000000..bc802c4da8 --- /dev/null +++ b/var/da/da_tools/da_llxy_rotated_latlon_1d.inc @@ -0,0 +1,60 @@ +subroutine da_llxy_rotated_latlon_1d(lat,lon, proj, x, y) + + !----------------------------------------------------------------------- + ! Purpose: Compute the x/y location of a lat/lon on a rotated LATLON grid. + ! Author : Syed RH Rizvi, MMM/NCAR + ! 06/01/2008 + !--------------------------------------------------------------------------- + + implicit none + + real, intent(in) :: lat(:) + real, intent(in) :: lon(:) + type(proj_info), intent(in) :: proj + real, intent(out) :: x(:) + real, intent(out) :: y(:) + + real, allocatable :: rot_lat(:), rot_lon(:), deltalat(:), deltalon(:), lon360(:) + real, allocatable :: xlat(:), xlon(:) + real :: cen_lat, cen_lon, latinc, loninc + integer :: n + + if (trace_use_frequent) call da_trace_entry("da_llxy_rotated_latlon_1d") + + n = size(lat) + allocate ( rot_lat(n), rot_lon(n), deltalat(n), deltalon(n), lon360(n), xlat(n), xlon(n) ) + + ! To account for issues around the dateline, convert the incoming + ! longitudes to be 0->360.0 + where (lon < 0) + lon360 = lon + 360.0 + elsewhere + lon360 = lon + end where + + xlat = deg_to_rad*lat + xlon = deg_to_rad*lon360 + cen_lat = deg_to_rad*proj%lat1 + cen_lon = deg_to_rad*proj%lon1 + if (cen_lon < 0.) cen_lon = cen_lon + 360. + + latinc = proj%latinc + loninc = proj%loninc + + rot_lon = rad_to_deg*atan( cos(xlat) * sin(xlon-cen_lon)/ & + (cos(cen_lat)*cos(xlat)*cos(xlon-cen_lon) + sin(cen_lat)*sin(xlat))) + rot_lat = rad_to_deg*asin( cos(cen_lat)*sin(xlat) - sin(cen_lat)*cos(xlat)*cos(xlon-cen_lon)) + + + deltalat = rot_lat + deltalon = rot_lon + + ! Compute x/y + x = proj%knowni + deltalon/loninc + 1.0 + y = proj%knownj + deltalat/latinc + 1.0 + + deallocate ( rot_lat, rot_lon, deltalat, deltalon, lon360, xlat, xlon ) + + if (trace_use_frequent) call da_trace_exit("da_llxy_rotated_latlon_1d") + +end subroutine da_llxy_rotated_latlon_1d diff --git a/var/da/da_tools/da_llxy_wrf_1d.inc b/var/da/da_tools/da_llxy_wrf_1d.inc new file mode 100644 index 0000000000..4a46d9b34c --- /dev/null +++ b/var/da/da_tools/da_llxy_wrf_1d.inc @@ -0,0 +1,51 @@ +subroutine da_llxy_wrf_1d(proj, lat, lon, x, y) + + !----------------------------------------------------------------------- + ! Purpose: Converts input lat/lon values to the cartesian (x, y) value + ! for the given projection. + !----------------------------------------------------------------------- + + implicit none + + type(proj_info), intent(in) :: proj + real, intent(in) :: lat(:) + real, intent(in) :: lon(:) + real, intent(out) :: x(:) + real, intent(out) :: y(:) + + if (trace_use_frequent) call da_trace_entry("da_llxy_wrf_1d") + + if (.NOT.proj%init) then + call da_error(__FILE__,__LINE__, & + (/"You have not called map_set for this projection!"/)) + end if + + select case(proj%code) + + case(PROJ_LATLON) + call da_llxy_latlon_1d(lat,lon,proj,x,y) + + case(PROJ_MERC) + call da_llxy_merc_1d(lat,lon,proj,x,y) + x = x + proj%knowni - 1.0 + y = y + proj%knownj - 1.0 + + case(PROJ_PS) + call da_llxy_ps_1d(lat,lon,proj,x,y) + + case(PROJ_LC) + call da_llxy_lc_1d(lat,lon,proj,x,y) + x = x + proj%knowni - 1.0 + y = y + proj%knownj - 1.0 + + case default + write(unit=message(1),fmt='(A,I2)') & + 'Unrecognized map projection code: ', proj%code + call da_error(__FILE__,__LINE__,message(1:1)) + end select + + if (trace_use_frequent) call da_trace_exit("da_llxy_wrf_1d") + +end subroutine da_llxy_wrf_1d + + diff --git a/var/da/da_tools/da_togrid_1d.inc b/var/da/da_tools/da_togrid_1d.inc new file mode 100644 index 0000000000..262a446e7f --- /dev/null +++ b/var/da/da_tools/da_togrid_1d.inc @@ -0,0 +1,44 @@ +subroutine da_togrid_1d (x, ib, ie, i, dx, dxm) + + !----------------------------------------------------------------------- + ! Purpose: Transfer obs. x to grid i and calculate its + ! distance to grid i and i+1 + !----------------------------------------------------------------------- + + implicit none + + real, intent(in) :: x(:) + integer, intent(in) :: ib, ie + real, intent(out) :: dx(:), dxm(:) + integer, intent(out) :: i(:) + + if (trace_use) call da_trace_entry("da_togrid_1d") + +! where (x(:) > 0.0) +! i = int (x) +! +! where(i(:) < ib) i = ib +! where(i(:) >= ie) i = ie-1 +! +! dx = x - real(i) +! dxm = 1.0 - dx +! elsewhere +! i = 0 +! dx = 0.0 +! dxm = 0.0 +! end where + + i = int (x) + where (i(:) < ib) + i = ib + elsewhere (i(:) >= ie) + i = ie - 1 + end where + dx = x - real(i) + dxm = 1.0 - dx + + if (trace_use) call da_trace_exit("da_togrid_1d") + +end subroutine da_togrid_1d + + diff --git a/var/da/da_tools/da_tools.f90 b/var/da/da_tools/da_tools.f90 index ced8aa918b..fa5247d1c1 100644 --- a/var/da/da_tools/da_tools.f90 +++ b/var/da/da_tools/da_tools.f90 @@ -65,6 +65,18 @@ module da_tools #include "da_llxy_ps_new.inc" #include "da_llxy_wrf.inc" #include "da_llxy_wrf_new.inc" + +#include "da_llxy_1d.inc" +#include "da_llxy_default_1d.inc" +#include "da_llxy_kma_global_1d.inc" +#include "da_llxy_global_1d.inc" +#include "da_llxy_rotated_latlon_1d.inc" +#include "da_llxy_latlon_1d.inc" +#include "da_llxy_lc_1d.inc" +#include "da_llxy_merc_1d.inc" +#include "da_llxy_ps_1d.inc" +#include "da_llxy_wrf_1d.inc" + #include "da_xyll.inc" #include "da_xyll_default.inc" #include "da_xyll_latlon.inc" @@ -98,6 +110,7 @@ module da_tools #include "da_smooth_anl.inc" #include "da_togrid_new.inc" #include "da_togrid.inc" +#include "da_togrid_1d.inc" #include "da_unifva.inc" #include "da_buddy_qc.inc" diff --git a/var/run/VARBC.in b/var/run/VARBC.in index 247053c015..8c407c79eb 100644 --- a/var/run/VARBC.in +++ b/var/run/VARBC.in @@ -1,5 +1,5 @@ VARBC version 1.0 - Number of instruments: - 48 + 49 ------------------------------------------------ Platform_id Sat_id Sensor_id Nchanl Npredmax ------------------------------------------------ @@ -2405,6 +2405,25 @@ 8 8 0 0 0 0 0 -1 -1 -1 -0.600 0.000 0.000 0.000 0.000 9 9 0 0 0 0 0 -1 -1 -1 -1.000 0.000 0.000 0.000 0.000 10 10 0 0 0 0 0 -1 -1 -1 -2.000 0.000 0.000 0.000 0.000 + ------------------------------------------------ + Platform_id Sat_id Sensor_id Nchanl Npredmax + ------------------------------------------------ + 4 16 44 10 8 + -----> Bias predictor statistics: Mean & Std & Nbgerr + 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 + 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 + 10000 10000 10000 10000 10000 10000 10000 10000 + -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param + 1 1 0 0 0 0 0 -1 -1 -1 2.100 0.000 0.000 0.000 0.000 + 2 2 0 0 0 0 0 -1 -1 -1 0.299 0.000 -0.001 -0.006 0.009 + 3 3 0 0 0 0 0 -1 -1 -1 0.516 0.001 -0.005 0.000 0.019 + 4 4 0 0 0 0 0 -1 -1 -1 -0.095 -0.005 0.001 -0.002 0.024 + 5 5 0 0 0 0 0 -1 -1 -1 -1.000 0.000 0.000 0.000 0.000 + 6 6 0 0 0 0 0 -1 -1 -1 0.000 0.000 0.000 0.000 0.000 + 7 7 0 0 0 0 0 -1 -1 -1 -0.800 0.000 0.000 0.000 0.000 + 8 8 0 0 0 0 0 -1 -1 -1 -0.600 0.000 0.000 0.000 0.000 + 9 9 0 0 0 0 0 -1 -1 -1 -1.000 0.000 0.000 0.000 0.000 + 10 10 0 0 0 0 0 -1 -1 -1 -2.000 0.000 0.000 0.000 0.000 ------------------------------------------------ Platform_id Sat_id Sensor_id Nchanl Npredmax ------------------------------------------------ diff --git a/var/run/radiance_info/goes-16-abi.info b/var/run/radiance_info/goes-16-abi.info new file mode 100644 index 0000000000..7c3cd410c8 --- /dev/null +++ b/var/run/radiance_info/goes-16-abi.info @@ -0,0 +1,11 @@ +sensor channel IR/MW use idum varch polarisation(0:vertical;1:horizontal) + 1023 7 1 -1 0 2.7200000000E+00 0.0000000000E+00 25.00000 12.00000 + 1023 8 1 1 0 1.7900000000E+00 0.0000000000E+00 8.60000 18.00000 + 1023 9 1 1 0 1.9200000000E+00 0.0000000000E+00 12.00000 26.00000 + 1023 10 1 1 0 1.7400000000E+00 0.0000000000E+00 16.90000 23.00000 + 1023 11 1 -1 0 5.0000000000E+00 0.0000000000E+00 27.00000 18.00000 + 1023 12 1 -1 0 2.7900000000E+00 0.0000000000E+00 15.00000 10.00000 + 1023 13 1 -1 0 3.0800000000E+00 0.0000000000E+00 28.00000 20.00000 + 1023 14 1 -1 0 3.0600000000E+00 0.0000000000E+00 28.00000 20.00000 + 1023 15 1 -1 0 2.8200000000E+00 0.0000000000E+00 28.00000 20.00000 + 1023 16 1 -1 0 1.7400000000E+00 0.0000000000E+00 20.00000 12.00000 diff --git a/var/run/radiance_info/goes-17-abi.info b/var/run/radiance_info/goes-17-abi.info new file mode 100644 index 0000000000..db8322f635 --- /dev/null +++ b/var/run/radiance_info/goes-17-abi.info @@ -0,0 +1,11 @@ +sensor channel IR/MW use idum varch polarisation(0:vertical;1:horizontal) + 1023 7 1 -1 0 5.0000000000E+00 0.0000000000E+00 40.00000 8.00000 + 1023 8 1 1 0 5.0000000000E+00 0.0000000000E+00 10.00000 9.00000 + 1023 9 1 1 0 5.0000000000E+00 0.0000000000E+00 16.00000 15.00000 + 1023 10 1 1 0 5.0000000000E+00 0.0000000000E+00 21.00000 19.00000 + 1023 11 1 -1 0 5.0000000000E+00 0.0000000000E+00 40.00000 8.00000 + 1023 12 1 -1 0 10.0000000000E+00 0.0000000000E+00 30.00000 8.00000 + 1023 13 1 -1 0 5.0000000000E+00 0.0000000000E+00 40.00000 8.00000 + 1023 14 1 -1 0 5.0000000000E+00 0.0000000000E+00 40.00000 8.00000 + 1023 15 1 -1 0 5.0000000000E+00 0.0000000000E+00 40.00000 8.00000 + 1023 16 1 -1 0 5.0000000000E+00 0.0000000000E+00 30.00000 8.00000 From 5da1d24b8bbc429c6413386ab30e34f0f573697e Mon Sep 17 00:00:00 2001 From: jordanschnell Date: Tue, 23 Jan 2024 12:41:50 -0500 Subject: [PATCH 33/41] Fix Registry description for setvel_5 (#1985) TYPE: text only KEYWORDS: GOCART settling, description of bin 5 settling SOURCE: encyclica DESCRIPTION OF CHANGES: Updated the registry to correct tezxt Solution: Text change ISSUE: For use when this PR closes an issue. Fixes #1982 LIST OF MODIFIED FILES: M Registry/registry.chem TESTS CONDUCTED: None RELEASE NOTE: Updates registry for variable description of settling velocity in bin 5 --- Registry/registry.chem | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Registry/registry.chem b/Registry/registry.chem index 70586eae72..f4a3039ab5 100644 --- a/Registry/registry.chem +++ b/Registry/registry.chem @@ -213,7 +213,7 @@ state real setvel_1 ij misc 1 - r "set state real setvel_2 ij misc 1 - r "setvel_2" "dust gravitational settling velocity for size 2" "m/s" state real setvel_3 ij misc 1 - r "setvel_3" "dust gravitational settling velocity for size 3" "m/s" state real setvel_4 ij misc 1 - r "setvel_4" "dust gravitational settling velocity for size 4" "m/s" -state real setvel_5 ij misc 1 - r "setvel_5" "effective gravitational settling velocity for total" "m/s" +state real setvel_5 ij misc 1 - r "setvel_5" "dust gravitational settling velocity for size 5" "m/s" state real dustgraset_1 ij misc 1 - r "graset_1" "Accumulated dust gravitational settling for size 1" "kg/m2" state real dustgraset_2 ij misc 1 - r "graset_2" "Accumulated dust gravitational settling for size 2" "kg/m2" state real dustgraset_3 ij misc 1 - r "graset_3" "Accumulated dust gravitational settling for size 3" "kg/m2" From e18082cd6a59f0c2452878a5a821b72b4b066ee2 Mon Sep 17 00:00:00 2001 From: Ted Mansell <37668594+MicroTed@users.noreply.github.com> Date: Tue, 23 Jan 2024 12:14:34 -0600 Subject: [PATCH 34/41] Add 3-moment option to NSSL microphysics (plus other minor scheme updates) (#1876) TYPE: enhancement KEYWORDS: microphysics, NSSL scheme SOURCE: Ted Mansell (NOAA/NSSL) (MicroTed) DESCRIPTION OF CHANGES: 3-moment bulk microphysics provides more accurate size-sorting of fast-falling hydrometeors (rain, graupel, hail) by effectively predicting the shape parameter of the gamma function particle size distribution. Also various updates to increase run-time flexibility, for example, it is now possible to predict CCN concentration but have hail turned off. Some bug fixes and changes in default settings, as well. The previous mp_physics options (17,19,21,22) still work as expected, but can be replicated with mp_physics=18 plus new namelist options. A new README.NSSLmp gives an overview of the scheme and tips on usage and some details on an internal namelist for setting additional options within the module. The 5th-order WENO advection (module_advect_em.F) has a decreased 'epsilon' value (1.d-40) to accommodate the order of magnitude of reflectivity moments. This should not noticeably affect scalar advection but will cause round-off differences. Another change fixes an NSSL-MP bug where sedimentation did not work for k > 128 (i.e., if number of model levels exceeds 128, sedimentation only worked for k <= 128). LIST OF MODIFIED FILES: Registry/Registry.EM_COMMON Registry/registry.var Registry/wrfplus chem/chemics_init.F dyn_em/module_advect_em.F dyn_em/solve_em.F dyn_em/start_em.F phys/module_microphysics_driver.F phys/module_mp_nssl_2mom.F phys/module_physics_init.F phys/module_diagnostics_driver.F phys/module_diag_nwp.F wrftladj/module_microphysics_driver_ad.F wrftladj/module_microphysics_driver_tl.F run/README.namelist share/module_check_a_mundo.F doc/README.NSSLmp (new file) TESTS CONDUCTED: It passed the regression tests. RELEASE NOTE: Adds 3-moment option to NSSL microphysics scheme (for rain, graupel, and hail) (mp_physics=18). Changes to snow aggregation parameters reduce stratiform reflectivity bias. Also adds namelist options to enable/disable bulk CCN prediction and graupel/hail density prediction, and deprecates old mp_physics options (17, 19, 21, 22). Main default parameter changes are for graupel/hail fall speed options (icdx, icdxhl; changed from 3 to 6), and default maximum gr/hail droplet collection efficiencies (ehw0/ehlw0 changed from 0.5/0.75 to 0.9/0.9) See README.NSSLmp for details. Also fixes a problem for high resolution vertical domains with nz > 128, where hydrometeor sedimentation did not work at k > 128 (this bug affected most or all previous releases). --- Registry/Registry.EM_COMMON | 70 +- Registry/registry.var | 15 +- Registry/registry.wrfplus | 6 +- chem/chemics_init.F | 4 +- doc/README.NSSLmp | 165 + dyn_em/module_advect_em.F | 4 +- dyn_em/solve_em.F | 7 +- dyn_em/start_em.F | 18 +- phys/module_diag_nwp.F | 33 +- phys/module_diagnostics_driver.F | 64 +- phys/module_microphysics_driver.F | 312 +- phys/module_mp_nssl_2mom.F | 6067 +++++++++++++++++++--- phys/module_physics_init.F | 126 +- run/README.namelist | 35 +- share/module_check_a_mundo.F | 101 +- wrftladj/module_microphysics_driver_ad.F | 4 +- wrftladj/module_microphysics_driver_tl.F | 4 +- 17 files changed, 5821 insertions(+), 1214 deletions(-) create mode 100644 doc/README.NSSLmp diff --git a/Registry/Registry.EM_COMMON b/Registry/Registry.EM_COMMON index 3e0231ff29..5f7b2ab833 100644 --- a/Registry/Registry.EM_COMMON +++ b/Registry/Registry.EM_COMMON @@ -543,6 +543,12 @@ state real qvolg ikjftb scalar 1 - \ i0rhusdf=(bdy_interp:dt) "QVGRAUPEL" "Graupel Particle Volume" "m(3) kg(-1)" state real qvolh ikjftb scalar 1 - \ i0rhusdf=(bdy_interp:dt) "QVHAIL" "Hail Particle Volume" "m(3) kg(-1)" +state real qzr ikjftb scalar 1 - \ + i0rhusdf=(bdy_interp:dt) "QZRAIN" "Sixth moment rain" "m(6) kg(-1)" +state real qzg ikjftb scalar 1 - \ + i0rhusdf=(bdy_interp:dt) "QZGRAUPEL" "Sixth moment graupel" "m(6) kg(-1)" +state real qzh ikjftb scalar 1 - \ + i0rhusdf=(bdy_interp:dt) "QZHAIL" "Sixth moment hail" "m(6) kg(-1)" state real qrimef ikjftb scalar 1 - \ i0rhusdf=(bdy_interp:dt) "QRIMEF" "rime factor * qi" "kg kg-1" state real qir ikjftb scalar 1 - \ @@ -591,6 +597,12 @@ state real dfi_qnn ikjftb dfi_scalar 1 - \ rusdf=(bdy_interp:dt) "DFI_QNCC" "DFI CNN Number concentration" "# kg(-1)" state real dfi_qnc ikjftb dfi_scalar 1 - \ rusdf=(bdy_interp:dt) "DFI_QNCLOUD" "DFI Cloud Number concentration" "# kg(-1)" +state real dfi_qzr ikjftb dfi_scalar 1 - \ + rhusdf=(bdy_interp:dt) "DFI_QZRAIN" "DFI Rain Reflectivity" "m(6) kg(-1)" +state real dfi_qzg ikjftb dfi_scalar 1 - \ + rhusdf=(bdy_interp:dt) "DFI_QZGRAUPEL" "DFI Graupel Reflectivity" "m(6) kg(-1)" +state real dfi_qzh ikjftb dfi_scalar 1 - \ + rhusdf=(bdy_interp:dt) "DFI_QZHAIL" "DFI Hail Reflectivity" "m(6) kg(-1)" state real dfi_qvolg ikjftb dfi_scalar 1 - \ rhusdf=(bdy_interp:dt) "DFI_QVGRAUPEL" "DFI Graupel Particle Volume" "m(3) kg(-1)" state real dfi_qvolh ikjftb dfi_scalar 1 - \ @@ -2385,16 +2397,27 @@ rconfig logical write_thompson_tables namelist,physics 1 .tru rconfig logical write_thompson_mp38table namelist,physics 1 .false. rconfig integer mp_physics namelist,physics max_domains -1 irh "mp_physics" "" "" #rconfig integer milbrandt_ccntype namelist,physics max_domains 0 rh "milbrandt select maritime(1)/continental(2)" "" "" -rconfig real nssl_cccn namelist,physics max_domains 0.5e9 rh "Base CCN concentration for NSSL microphysics" "" "" -rconfig real nssl_alphah namelist,physics max_domains 0 rh "Graupel PSD shape paramter" "" "" -rconfig real nssl_alphahl namelist,physics max_domains 1 rh "Hail PSD shape paramter" "" "" -rconfig real nssl_cnoh namelist,physics max_domains 4.e5 rh "Graupel intercept paramter" "" "" -rconfig real nssl_cnohl namelist,physics max_domains 4.e4 rh "Hail intercept paramter" "" "" -rconfig real nssl_cnor namelist,physics max_domains 8.e5 rh "Rain intercept paramter" "" "" -rconfig real nssl_cnos namelist,physics max_domains 3.e6 rh "Snow intercept paramter" "" "" -rconfig real nssl_rho_qh namelist,physics max_domains 500. rh "Graupel particle density" "" "" -rconfig real nssl_rho_qhl namelist,physics max_domains 900. rh "Hail particle density" "" "" -rconfig real nssl_rho_qs namelist,physics max_domains 100. rh "Snow particle density" "" "" +rconfig real nssl_cccn namelist,physics 1 0.5e9 rh "Base CCN concentration for NSSL microphysics" "" "" +rconfig real nssl_alphah namelist,physics 1 0 rh "Graupel PSD shape paramter" "" "" +rconfig real nssl_alphahl namelist,physics 1 1 rh "Hail PSD shape paramter" "" "" +rconfig real nssl_cnoh namelist,physics 1 4.e5 rh "Graupel intercept paramter" "" "" +rconfig real nssl_cnohl namelist,physics 1 4.e4 rh "Hail intercept paramter" "" "" +rconfig real nssl_cnor namelist,physics 1 8.e5 rh "Rain intercept paramter" "" "" +rconfig real nssl_cnos namelist,physics 1 3.e6 rh "Snow intercept paramter" "" "" +rconfig real nssl_rho_qh namelist,physics 1 500. rh "Graupel particle density" "" "" +rconfig real nssl_rho_qhl namelist,physics 1 900. rh "Hail particle density" "" "" +rconfig real nssl_rho_qs namelist,physics 1 100. rh "Snow particle density" "" "" +rconfig integer nssl_icdx namelist,physics 1 6 rh "NSSL Graupel fall speed option" "" "" +rconfig integer nssl_icdxhl namelist,physics 1 6 rh "NSSL Hail fall speed option" "" "" +rconfig integer nssl_hail_on namelist,physics max_domains -1 rh "NSSL Hail flag" "" "" +rconfig integer nssl_ccn_on namelist,physics 1 -1 rh "NSSL CCN flag" "" "" +rconfig integer nssl_ccn_is_ccna namelist,physics 1 0 rh "NSSL flag that CCN is CCNA" "" "" +rconfig integer nssl_2moment_on namelist,physics 1 -1 rh "NSSL 2-moment flag" "" "" +rconfig integer nssl_3moment namelist,physics 1 0 rh "NSSL 3-moment flag" "" "" +rconfig integer nssl_density_on namelist,physics 1 -1 rh "NSSL graupel/hail density flag" "" "" + + + rconfig integer CCNTY namelist,physics 1 2 rh "Aerosol background type for NTU microphysics" "" "" # Lightning Qv Nudging @@ -2995,11 +3018,8 @@ package cammgmpscheme mp_physics==11 - moist:qv,qc package sbu_ylinscheme mp_physics==13 - moist:qv,qc,qr,qi,qs;state:rimi package wdm5scheme mp_physics==14 - moist:qv,qc,qr,qi,qs;scalar:qnn,qnc,qnr;state:re_cloud,re_ice,re_snow package wdm6scheme mp_physics==16 - moist:qv,qc,qr,qi,qs,qg;scalar:qnn,qnc,qnr;state:re_cloud,re_ice,re_snow -package nssl_2mom mp_physics==17 - moist:qv,qc,qr,qi,qs,qg,qh;scalar:qndrop,qnr,qni,qns,qng,qnh,qvolg,qvolh;state:re_cloud,re_ice,re_snow -package nssl_2momccn mp_physics==18 - moist:qv,qc,qr,qi,qs,qg,qh;scalar:qnn,qndrop,qnr,qni,qns,qng,qnh,qvolg,qvolh;state:re_cloud,re_ice,re_snow -package nssl_1mom mp_physics==19 - moist:qv,qc,qr,qi,qs,qg,qh;scalar:qvolg -package nssl_1momlfo mp_physics==21 - moist:qv,qc,qr,qi,qs,qg -package nssl_2momg mp_physics==22 - moist:qv,qc,qr,qi,qs,qg;scalar:qndrop,qnr,qni,qns,qng,qvolg;state:re_cloud,re_ice,re_snow +# Note: Options 17, 19, 21, 22 are deprecated but still reserved for compatibility -- for now +package nssl_2mom mp_physics==18 - moist:qv,qc,qr,qi,qs,qg package wsm7scheme mp_physics==24 - moist:qv,qc,qr,qi,qs,qg,qh;state:re_cloud,re_ice,re_snow package wdm7scheme mp_physics==26 - moist:qv,qc,qr,qi,qs,qg,qh;scalar:qnn,qnc,qnr;state:re_cloud,re_ice,re_snow package thompsonaero mp_physics==28 - moist:qv,qc,qr,qi,qs,qg;scalar:qni,qnr,qnc,qnwfa,qnifa,qnbca;state:re_cloud,re_ice,re_snow,qnwfa2d,qnifa2d,taod5503d,taod5502d @@ -3015,6 +3035,16 @@ package etampnew mp_physics==95 - moist:qv,qc package gsfcgcescheme mp_physics==97 - moist:qv,qc,qr,qi,qs,qg package madwrf_mp mp_physics==96 - moist:qv,qc,qi,qs +package nssl2mconc nssl_2moment_on==1 - scalar:qndrop,qnr,qni,qns,qng;state:re_cloud,re_ice,re_snow +package nssl3mg nssl_3moment==1 - scalar:qzr,qzg +package nssl3m nssl_3moment==2 - scalar:qzr,qzg,qzh +package nssl_hail nssl_hail_on==1 - moist:qh;scalar:qnh +package nssl_hail1m nssl_hail_on==2 - moist:qh; +package nssl_ccn_opt nssl_ccn_on==1 - scalar:qnn +package nssl_graupelvol nssl_density_on==1 - scalar:qvolg +package nssl_hailvol nssl_density_on==2 - scalar:qvolg,qvolh + + package radar_refl compute_radar_ref==1 - state:refl_10cm,refd_max endif @@ -3038,10 +3068,12 @@ package morr_two_moment_dfi mp_physics_dfi==10 - dfi_moist:dfi #package sbu_ylinscheme_dfi mp_physics==13 - dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs;state:rimi package wdm5scheme_dfi mp_physics_dfi==14 - dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs;dfi_scalar:dfi_qnn,dfi_qnc,dfi_qnr;state:dfi_re_cloud,dfi_re_ice,dfi_re_snow package wdm6scheme_dfi mp_physics_dfi==16 - dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg;dfi_scalar:dfi_qnn,dfi_qnc,dfi_qnr;state:dfi_re_cloud,dfi_re_ice,dfi_re_snow -package nssl_2mom_dfi mp_physics_dfi==17 - dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg,dfi_qh;dfi_scalar:dfi_qndrop,dfi_qnr,dfi_qni,dfi_qns,dfi_qng,dfi_qnh,dfi_qvolg,dfi_qvolh;state:dfi_re_cloud,dfi_re_ice,dfi_re_snow -package nssl_2mom_dficcn mp_physics_dfi==18 - dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg,dfi_qh;dfi_scalar:dfi_qndrop,dfi_qnn,dfi_qnr,dfi_qni,dfi_qns,dfi_qng,dfi_qnh,dfi_qvolg;state:dfi_re_cloud,dfi_re_ice,dfi_re_snow -package nssl_1mom_dfi mp_physics_dfi==19 - dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg,dfi_qh;dfi_scalar:dfi_qvolg -package nssl_1momlfo_dfi mp_physics_dfi==21 - dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg +#package nssl_2mom_dfi mp_physics_dfi==17 - dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg,dfi_qh;dfi_scalar:dfi_qndrop,dfi_qnr,dfi_qni,dfi_qns,dfi_qng,dfi_qnh,dfi_qvolg,dfi_qvolh;state:dfi_re_cloud,dfi_re_ice,dfi_re_snow +#package nssl_2mom_dficcn mp_physics_dfi==18 - dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg,dfi_qh;dfi_scalar:dfi_qndrop,dfi_qnn,dfi_qnr,dfi_qni,dfi_qns,dfi_qng,dfi_qnh,dfi_qvolg;state:dfi_re_cloud,dfi_re_ice,dfi_re_snow +package nssl_2mom_dfi mp_physics_dfi==18 - dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg,dfi_qh;dfi_scalar:dfi_qndrop,dfi_qnn,dfi_qnr,dfi_qni,dfi_qns,dfi_qng,dfi_qnh,dfi_qvolg;state:dfi_re_cloud,dfi_re_ice,dfi_re_snow +#package nssl_1mom_dfi mp_physics_dfi==19 - dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg,dfi_qh;dfi_scalar:dfi_qvolg +#package nssl_1momlfo_dfi mp_physics_dfi==21 - dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg +#package nssl_2momg_dfi mp_physics_dfi==22 - dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg;dfi_scalar:dfi_qndrop,dfi_qnr,dfi_qni,dfi_qns,dfi_qng,dfi_qvolg;state:dfi_re_cloud,dfi_re_ice,dfi_re_snow package wsm7scheme_dfi mp_physics_dfi==24 - dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg,dfi_qh;state:dfi_re_cloud,dfi_re_ice,dfi_re_snow package wdm7scheme_dfi mp_physics_dfi==26 - dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg,dfi_qh;dfi_scalar:dfi_qnn,dfi_qnc,dfi_qnr;state:dfi_re_cloud,dfi_re_ice,dfi_re_snow package thompsonaero_dfi mp_physics_dfi==28 - dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg;dfi_scalar:dfi_qni,dfi_qnr,dfi_qnc,dfi_qnwfa,dfi_qnifa,dfi_qnbca;state:dfi_re_cloud,dfi_re_ice,dfi_re_snow diff --git a/Registry/registry.var b/Registry/registry.var index 366e1c2da0..32cc1471db 100644 --- a/Registry/registry.var +++ b/Registry/registry.var @@ -593,11 +593,8 @@ package cammgmpscheme mp_physics==11 - moist:qv,qc package sbu_ylinscheme mp_physics==13 - moist:qv,qc,qr,qi,qs package wdm5scheme mp_physics==14 - moist:qv,qc,qr,qi,qs package wdm6scheme mp_physics==16 - moist:qv,qc,qr,qi,qs,qg -package nssl_2mom mp_physics==17 - moist:qv,qc,qr,qi,qs,qg,qh -package nssl_2momccn mp_physics==18 - moist:qv,qc,qr,qi,qs,qg,qh -package nssl_1mom mp_physics==19 - moist:qv,qc,qr,qi,qs,qg,qh -package nssl_1momlfo mp_physics==21 - moist:qv,qc,qr,qi,qs,qg -package nssl_2momg mp_physics==22 - moist:qv,qc,qr,qi,qs,qg +# Note: Options 17, 19, 21, 22 are deprecated but still reserved for compatibility -- for now +package nssl_2mom mp_physics==18 - moist:qv,qc,qr,qi,qs,qg package thompsonaero mp_physics==28 - moist:qv,qc,qr,qi,qs,qg package p3_1category mp_physics==50 - moist:qv,qc,qr,qi package p3_1category_nc mp_physics==51 - moist:qv,qc,qr,qi @@ -607,6 +604,7 @@ package ntu mp_physics==56 - moist:qv,qc package etampnew mp_physics==95 - moist:qv,qc,qr,qs package lscondscheme mp_physics==98 - moist:qv package mkesslerscheme mp_physics==99 - moist:qv,qc,qr + # package mpnotset_4dvar mp_physics_4dvar==-1 - g_moist:g_qv;a_moist:a_qv package passiveqv_4dvar mp_physics_4dvar==0 - g_moist:g_qv;a_moist:a_qv @@ -626,11 +624,8 @@ package cammgmp_4dvar mp_physics_4dvar==11 - g_moist:g_q package sbu_ylin_4dvar mp_physics_4dvar==13 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs package wdm5_4dvar mp_physics_4dvar==14 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs package wdm6_4dvar mp_physics_4dvar==16 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs,a_qg -package nssl_2mom_4dvar mp_physics_4dvar==17 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg,g_qh;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs,a_qg,a_qh -package nssl_2momccn_4dvar mp_physics_4dvar==18 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg,g_qh;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs,a_qg,a_qh -package nssl_1mom_4dvar mp_physics_4dvar==19 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg,g_qh;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs,a_qg,a_qh -package nssl_1momlfo_4dvar mp_physics_4dvar==21 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs,a_qg -package nssl_2momg_4dvar mp_physics_4dvar==22 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs,a_qg +# Note: Options 17, 19, 21, 22 are deprecated but still reserved for compatibility -- for now +package nssl_2mom_4dvar mp_physics_4dvar==18 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg,g_qh;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs,a_qg,a_qh package thompsonaero_4dvar mp_physics_4dvar==28 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs,a_qg package p3_1category_4dvar mp_physics_4dvar==50 - g_moist:g_qv,g_qc,g_qr,g_qi;a_moist:a_qv,a_qc,a_qr,a_qi package p3_1category_nc_4dvar mp_physics_4dvar==51 - g_moist:g_qv,g_qc,g_qr,g_qi;a_moist:a_qv,a_qc,a_qr,a_qi diff --git a/Registry/registry.wrfplus b/Registry/registry.wrfplus index 7f277a882d..2b6f933c47 100644 --- a/Registry/registry.wrfplus +++ b/Registry/registry.wrfplus @@ -872,11 +872,7 @@ package cammgmp_plus mp_physics_plus==11 - g_moist:g_qv, package sbu_ylin_plus mp_physics_plus==13 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs package wdm5_plus mp_physics_plus==14 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs package wdm6_plus mp_physics_plus==16 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs,a_qg -package nssl_2mom_plus mp_physics_plus==17 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg,g_qh;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs,a_qg,a_qh -package nssl_2momccn_plus mp_physics_plus==18 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg,g_qh;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs,a_qg,a_qh -package nssl_1mom_plus mp_physics_plus==19 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg,g_qh;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs,a_qg,a_qh -package nssl_1momlfo_plus mp_physics_plus==21 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs,a_qg -package nssl_2momg_plus mp_physics_plus==22 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs,a_qg +package nssl_2mom_plus mp_physics_plus==18 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg,g_qh;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs,a_qg,a_qh package thompsonaero_plus mp_physics_plus==28 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs,a_qg package p3_1category_plus mp_physics_plus==50 - g_moist:g_qv,g_qc,g_qr,g_qi;a_moist:a_qv,a_qc,a_qr,a_qi package p3_1category_nc_plus mp_physics_plus==51 - g_moist:g_qv,g_qc,g_qr,g_qi;a_moist:a_qv,a_qc,a_qr,a_qi diff --git a/chem/chemics_init.F b/chem/chemics_init.F index 59f0546883..a0512f0a06 100755 --- a/chem/chemics_init.F +++ b/chem/chemics_init.F @@ -337,8 +337,8 @@ subroutine chem_init (id,chem,emis_ant,scalar,dt,bioemdt,photdt,chemdt,stepbioe, call wrf_error_fatal("ERROR: wet scavenging option requires chem_opt = 8 through 13 or 31 to 36 or 41 to 42 or 109 or 503 or 504 or 601 or 611 to function.") endif if ( config_flags%mp_physics /= 2 .and. config_flags%mp_physics /= 10 .and. config_flags%mp_physics /= 11 & - .and. config_flags%mp_physics /= 17 .and. config_flags%mp_physics /= 18 .and. config_flags%mp_physics /= 22) then - call wrf_error_fatal("ERROR: wet scavenging option requires mp_phys = 2 (Lin et al.) or 10 (Morrison) or 11 (CAMMGMP) or 17/18/22 NSSL_2mom to function.") + .and. .not. ( config_flags%mp_physics == 18 .and. config_flags%nssl_2moment_on == 1 ) ) then + call wrf_error_fatal("ERROR: wet scavenging option requires mp_phys = 2 (Lin et al.) or 10 (Morrison) or 11 (CAMMGMP) or 18 NSSL_2mom to function.") endif elseif( id == 1 ) then if ( config_flags%mp_physics /= 6 .and. config_flags%mp_physics /= 8 .and. config_flags%mp_physics /= 10 .and. config_flags%mp_physics /= 17 & diff --git a/doc/README.NSSLmp b/doc/README.NSSLmp new file mode 100644 index 0000000000..e9b673653e --- /dev/null +++ b/doc/README.NSSLmp @@ -0,0 +1,165 @@ +Some background information and usage tips for the NSSL microphysics scheme. + + + IMPORTANT: Best results are attained using WENO (Weighted Essentially Non-Oscillatory) scalar advection option. This helps to limit oscillations at the edges of precipitation regions (i.e., sharp gradient), which in turns helps to prevent mismatches of moments that can show up as noisy reflectivity values. + moist_adv_opt = 4, + scalar_adv_opt = 3, + The monotonic option (2) is less effective, but better than the default positive definite option (1) + +NOTE TO SMPAR or DM+SMPAR USERS: If a segmentation fault occurs, try setting the environment variable OMP_STACKSIZE to 8M or 16M (default is 4M, where M=MB). Note that this does not increase the shell stacksize limit [use 'ulimit -a unlimited' (bash) or 'unlimit stacksize' (tcsh)] + +CHANGES: +June 2023 (WRF 4.6): Main default option change is for graupel/hail fall speed options (icdx, icdxhl; changed from 3 to 6, see below), and default maximum gr/hail droplet collection efficiencies (ehw0/ehlw0 changed from 0.5/0.75 to 0.9/0.9, see below). Snow aggregation efficiency is reduced to limit excessive snow reflectivity (see below). + +CONTACT: For questions not covered here (or other issues/bugs), feel free to contact Ted Mansell (NOAA/NSSL) at ted.mansell_at_noaa.gov and/or tag @MicroTed in a github issue. + +DESCRIPTION: + +The NSSL bulk microphysical parameterization scheme describes form and phase changes among a range of liquid and ice hydrometeors, as described in Mansell et al. (2010) and Mansell and Ziegler (2013). It is designed with deep (severe) convection in mind at grid spacings of up to 4 km, but can also be run at larger grid spacing as needed for nesting etc. It is also able to capture non-severe and winter weather. The scheme predicts the mass mixing ratio and number concentration of cloud droplets, raindrops, cloud ice crystals (columns), snow particles (including large crystals and aggregates), graupel, and (optionally) hail. The 3-moment option additionally predicts the 6th moments of rain, graupel, and hail which in turn predicts the PSD shape parameters (set nssl_3moment=.true.). + +Basic options in physics namelist: + mp_physics = 18 ! NSSL scheme (2-moment) with hail and predicted + CCN concentration + options + + The legacy options (17,19,21,22) still behave as before (for now), but going + forward one should use mp_physics=18 with modifier flags: + + mp_physics + = 22 ! NSSL scheme (2-moment) without hail + Equivalent: mp=18, nssl_hail_on=0, nssl_ccn_on=0 + = 17 ! NSSL scheme (2-moment) with hail with constant background CCN + concentration + Equivalent: mp=18, nssl_ccn_on=0 + = 19, NSSL 1-moment (7 class: qv,qc,qr,qi,qs,qg,qh; predicts graupel density) + Equivalent: mp=18, nssl_2moment_on=0, nssl_ccn_on=0 (do no set nssl_hail_on) + = 21, NSSL 1-moment, (6-class), very similar to Gilmore et al. 2004 + Equivalent: mp=18, nssl_2moment_on=0, nssl_hail_on=0, nssl_ccn_on=0, + nssl_density_on=0 + +Option flags (integer; apply to all domains except nssl_hail_on): + + nssl_3moment : default value of 0, setting to 1 adds 6th moment for rain, + graupel (i.e., 3-moment ) and hail (Only needed for turning + 3-moment on) + + nssl_density_on : default value of 1; Setting to 0 turns off graupel/hail predicted + ice density and instead uses fixed (constant) ice density + for graupel (nssl_rho_qh, default 500.) and hail (nssl_rho_qhl, + default 800.) (Only needed for turning density off) + + nssl_ccn_on : predicted CCN concentration: default is on (1) for mp_physics=18 + + nssl_hail_on : If not set explicitly, it is set automatically to 1. This is the only + flag with dimensions of 'max_domains' e.g., so that hail can be turned + off on non-convection-allowing parent domains (Default is on, so this + is only needed for turning the hail species off) + + nssl_ccn_is_ccna : The CCN category, if enabled (=1), can be used to represent either the + number of unactivated CCN (default, value of 0, with irenuc=2), or, if + set to 1, it is CCNA (the number of activated CCN, background value + of zero). If irenuc >= 5 (see below), this is automatically set to 1. + + nssl_2moment_on : only use this flag to run single-moment (value of 0), otherwise + default is 1 (Only needed for turning 2-moment off) + + Other namelist options (also "physics" namelist) + nssl_alphah = 0. ! PSD shape parameter for graupel (1- and 2-moment) + nssl_alphahl = 1. ! PSD shape parameter for hail (1- and 2-moment) + nssl_cnoh = 4.e5 ! graupel intercept (1-moment only) + nssl_cnohl = 4.e4 ! hail intercept (1-moment only) + nssl_cnor = 8.e5 ! rain intercept (1-moment only) + nssl_cnos = 3.e6 ! snow intercept (1-moment only) + nssl_rho_qh = 500. ! graupel density (nssl_density_on=0) + nssl_rho_qhl = 800. ! hail density (nssl_density_on=0) + nssl_rho_qs = 100. ! snow density + + + nssl_cccn - (real) Initial concentration of cloud condensation + nuclei (per m^3 at sea level) + 0.25e+9 maritime + 0.5e+9 "low-med" continental (DEFAULT) + 1.0e+9 "med-high" continental + 1.5e+09 - high-extreme continental CCN) + Larger values run a risk of unrealistically weak + precipitation production + The value of nssl_cccn sets the concentration at MSL, and an initially + homogeneous number mixing ratio (ccn/1.225) is assumed throughout + the depth of the domain. The droplet concentration near cloud base + will be less than nssl_cccn because of the well-mixed assumption, + so if a target Nc is desired, set nssl_cccn higher by a factor of + 1.225/(air density at cloud base). + +The graupel and hail particle densities are also calculated by predicting the total particle volume. The graupel category therefore emulates a range of characteristics from high-density frozen drops (includes small hail) to low-density graupel (from rimed ice crystals/snow) in its size and density spectrum. The hail category is designed to simulate larger hail sizes. Hail is only produced from higher-density large graupel that is actively riming (esp. in wet growth). + +Hydrometeor size distributions are assumed to follow a gamma functional form. (Shape parameters for 2-moment graupel and hail can be set with nssl_alphah/nssl_alphahl.) Microphysical processes include cloud droplet and cloud ice nucleation, condensation, deposition, evaporation, sublimation, collection–coalescence, variable-density riming, shedding, ice multiplication, cloud ice aggregation, freezing and melting, and conversions between hydrometeor categories. + +Cloud concentration nuclei (CCN) concentration is predicted as in Mansell et al. (2010) with a bulk activation spectrum approximating small aerosols. (New option nssl_ccn_is_ccna=1 instead predicts the number of activated CCN.) The model tracks the number of unactivated CCN, and the local CCN concentration is depleted as droplets are activated, either at cloud base or in cloud. The CCN are subjected to advection and subgrid turbulent mixing but have no other interactions with hydrometeors; for example, scavenging by raindrops is omitted. CCN are restored by droplet evaporation and by a gradual regeneration when no hydrometeors are present (ccntimeconst). Aerosol sensitivity is enhanced by explicitly treating droplet condensation instead of using a saturation adjustment. Supersaturation (within reason) is allowed to persist in updraft with low droplet concentration. + +Droplet activation option method is controlled by the 'irenuc' option (internal to NSSL module). The default option (2) depletes CCN from the unactivated CCN field. A new option (7) instead counts the number of activated CCN (nucleated droplets) with the assumption of an initial constant CCN number mixing ratio. Option 7 better handles supersaturation at low CCN (e.g., maritime) concentrations by allowing extra droplet activation at high SS. + + irenuc : (nssl_mp_params namelist) + 2 = ccn field is UNactivated aerosol (default; old droplet activation) + Can switch to counting activated CCN with nssl_ccn_is_ccna=1 + 7 = ccn field must be ACTVIATED aerosol (new droplet activation) + Must have nssl_ccn_on=1 for irenuc=7 + +Excessive size sorting (common in 2-moment schemes) is effectively controlled by an adaptive breakup method that prevents reflectivity growth by sedimentation (Mansell 2010). For 2-moment, infall=4 (default; nssl_mp_params namelist) is recommended. For 3-moment, infall only really applies to droplets, cloud ice, and snow. + +Graupel -> hail conversion: The parameter ihlcnh selects the method of converting graupel (hail embryos) to the hail category. The default value is -1 for automatic setting. The original option (ihlcnh=1) is replaced by a new option (ihlcnh=3) as of May 2023. ihlcnh=3 converts from the graupel spectrum itself based on the wet growth diameter, which generally results in fewer initiated hailstones with larger diameters (and larger mean diameter at the ground). If hail size seems excessive, try setting ihlcnh=1, which tends to generate higher hail number concentrations and thus smaller diameters. + +The June 2023 (WRF 4.6) update introduces changes in the default options for graupel/hail fall speeds and collection efficiencies. The original fall speed options (icdx=3; icdxhl=3) from Mansell et al. (2010) are switched to the Milbrandt and Morrison (2013) fall speed curves (icdx=6; icdxhl=6). Because the fall speeds are generally a bit lower, a partially compensating increase in maximum collection efficiency is set by default: ehw0/ehlw0 increased to 0.9. One effect is somewhat reduced total precipitation and cold pool intensity for supercell storms. + + (nssl_mp_params namelist) + icdx - fall speed option for graupel (was 3, now is 6) + icdxhl - fall speed option for hail (was 3, now is 6) + ehw0,ehlw0 - Maximim droplet collection efficiencies for graupel (ehw0=0.75, now 0.9) + and hail (ehlw0=0.75, now 0.9) + ihlcnh - graupel to hail conversion option (was 1, now 3) + +In summary, to get something closer to previous behavior, use the following: + +&nssl_mp_params + icdx = 3 + icdxhl = 3 + ehw0 = 0.5 + ehlw0 = 0.75 + ihlcnh = 1 +/ + +Snow Aggregation and reflectivity: + +Snow self-collection (aggregation) has been curbed in the 4.6 version by reducing the collision efficiency and the temperature range over which aggregation is allowed (esstem): + + ess0 = 0.5 ! collision efficiency, reduced from 1 to 0.5 + esstem1 = -15. ! was -25. ! lower temperature where snow aggregation turns on + esstem2 = -10. ! was -20. ! higher temperature for linear ramp of ess from zero at esstem1 to formula value at esstem2 + + If desired, some further reduction in aggregation can be gained from setting iessopt=4, which reduces ess0 to 0.1 (80% reduction) in conditions of ice subsaturation (RHice < 100%). + Snow reflectivity formerly had a default setting that turned on a crude bright band enhancement (iusewetsnow=1). This is now turned off by default (iusewetsnow=0) + These snow parameters can be accessed through the nssl_mp_params namelist. + +References: + +Mansell, E. R., C. L. Ziegler, and E. C. Bruning, 2010: Simulated electrification + of a small thunderstorm with two-moment bulk microphysics. J. Atmos. Sci., + 67, 171-194, doi:10. 1175/2009JAS2965.1. + +Mansell, E. R. and C. L. Ziegler, 2013: Aerosol effects on simulated storm + electrification and precipitation in a two-moment bulk microphysics model. + J. Atmos. Sci., 70 (7), 2032-2050, doi:10.1175/JAS-D-12-0264.1. + +Mansell, E. R., D. T. Dawson, J. M. Straka, Bin-emulating Hail Melting in 3-moment + bulk microphysics, J. Atmos. Sci., 77, 3361-3385, doi: 10.1175/JAS-D-19-0268.1 + +Ziegler, C. L., 1985: Retrieval of thermal and microphysical variables in observed + convective storms. Part I: Model development and preliminary testing. J. + Atmos. Sci., 42, 1487-1509. + +Sedimentation reference: + +Mansell, E. R., 2010: On sedimentation and advection in multimoment bulk microphysics. + J. Atmos. Sci., 67, 3084-3094, doi:10.1175/2010JAS3341.1. + + + + diff --git a/dyn_em/module_advect_em.F b/dyn_em/module_advect_em.F index 58145e340f..3c2ed3a630 100644 --- a/dyn_em/module_advect_em.F +++ b/dyn_em/module_advect_em.F @@ -7956,7 +7956,7 @@ SUBROUTINE advect_scalar_weno ( field, field_old, tendency, & real :: qim2, qim1, qi, qip1, qip2 double precision :: beta0, beta1, beta2, f0, f1, f2, wi0, wi1, wi2, sumwk - double precision, parameter :: gi0 = 1.d0/10.d0, gi1 = 6.d0/10.d0, gi2 = 3.d0/10.d0, eps=1.0d-28 + double precision, parameter :: gi0 = 1.d0/10.d0, gi1 = 6.d0/10.d0, gi2 = 3.d0/10.d0, eps=1.0d-40 integer, parameter :: pw = 2 @@ -8652,7 +8652,7 @@ SUBROUTINE advect_scalar_wenopd ( field, field_old, tendency, & real :: qim2, qim1, qi, qip1, qip2 double precision :: beta0, beta1, beta2, f0, f1, f2, wi0, wi1, wi2, sumwk - double precision, parameter :: gi0 = 1.d0/10.d0, gi1 = 6.d0/10.d0, gi2 = 3.d0/10.d0, eps1=1.0d-28 + double precision, parameter :: gi0 = 1.d0/10.d0, gi1 = 6.d0/10.d0, gi2 = 3.d0/10.d0, eps1=1.0d-40 integer, parameter :: pw = 2 diff --git a/dyn_em/solve_em.F b/dyn_em/solve_em.F index 92d5b73fed..39cdf85723 100644 --- a/dyn_em/solve_em.F +++ b/dyn_em/solve_em.F @@ -3810,6 +3810,7 @@ END SUBROUTINE CMAQ_DRIVER & , SNOWNC=grid%snownc, SNOWNCV=grid%snowncv & & , GRAUPELNC=grid%graupelnc, GRAUPELNCV=grid%graupelncv & ! for milbrandt2mom & , HAILNC=grid%hailnc, HAILNCV=grid%hailncv & + & , HAIL_MAXK1=grid%hail_maxk1,HAIL_MAX2D=grid%hail_max2d & & , W=grid%w_2, Z=grid%z, HT=grid%ht & & , MP_RESTART_STATE=grid%mp_restart_state & & , TBPVS_STATE=grid%tbpvs_state & ! etampnew @@ -3859,11 +3860,11 @@ END SUBROUTINE CMAQ_DRIVER & , QNI3_CURR=scalar(ims,kms,jms,P_QNI3), F_QNI3=F_QNI3 & ! for Jensen ISHMAEL & , QVOLI3_CURR=scalar(ims,kms,jms,P_QVOLI3), F_QVOLI3=F_QVOLI3 & ! for Jensen ISHMAEL & , QAOLI3_CURR=scalar(ims,kms,jms,P_QAOLI3), F_QAOLI3=F_QAOLI3 & ! for Jensen ISHMAEL -! & , QZR_CURR=scalar(ims,kms,jms,P_QZR), F_QZR=F_QZR & ! for milbrandt3mom + & , QZR_CURR=scalar(ims,kms,jms,P_QZR), F_QZR=F_QZR & ! for milbrandt3mom & , QZI_CURR=scalar(ims,kms,jms,P_QZI), F_QZI=F_QZI & ! for 3-moment P3 ! & , QZS_CURR=scalar(ims,kms,jms,P_QZS), F_QZS=F_QZS & ! " -! & , QZG_CURR=scalar(ims,kms,jms,P_QZG), F_QZG=F_QZG & ! " -! & , QZH_CURR=scalar(ims,kms,jms,P_QZH), F_QZH=F_QZH & ! " + & , QZG_CURR=scalar(ims,kms,jms,P_QZG), F_QZG=F_QZG & ! " + & , QZH_CURR=scalar(ims,kms,jms,P_QZH), F_QZH=F_QZH & ! " & , QVOLG_CURR=scalar(ims,kms,jms,P_QVOLG), F_QVOLG=F_QVOLG & ! for nssl_2mom & , QVOLH_CURR=scalar(ims,kms,jms,P_QVOLH), F_QVOLH=F_QVOLH & ! for nssl_2mom & , QDCN_CURR=scalar(ims,kms,jms,P_QDCN), F_QDCN=F_QDCN & ! for ntu3m diff --git a/dyn_em/start_em.F b/dyn_em/start_em.F index 941b64a1c5..97a5bfcdcf 100644 --- a/dyn_em/start_em.F +++ b/dyn_em/start_em.F @@ -1234,15 +1234,7 @@ SUBROUTINE start_domain_em ( grid, allowed_to_read & grid%itimestep, grid%fdob, & t00, p00, a, & ! for obs_nudge base state grid%TYR, grid%TYRA, grid%TDLY, grid%TLAG, grid%NYEAR, grid%NDAY,grid%tmn_update, & - grid%achfx, grid%aclhf, grid%acgrdflx, & - config_flags%nssl_cccn, & - config_flags%nssl_alphah, config_flags%nssl_alphahl, & - config_flags%nssl_cnoh, config_flags%nssl_cnohl, & - config_flags%nssl_cnor, config_flags%nssl_cnos, & - config_flags%nssl_rho_qh, config_flags%nssl_rho_qhl, & - config_flags%nssl_rho_qs, & - config_flags%nssl_ipelec, & - config_flags%nssl_isaund & + grid%achfx, grid%aclhf, grid%acgrdflx & ,grid%RQCNCUTEN, grid%RQINCUTEN,grid%rliq & !mchen add for cammpmg ,grid%cldfra_dp,grid%cldfra_sh & ! ckay for subgrid cloud ,grid%te_temf,grid%cf3d_temf,grid%wm_temf & ! WA @@ -1759,8 +1751,12 @@ SUBROUTINE start_domain_em ( grid, allowed_to_read & IF ( f_qnn ) THEN IF ( config_flags%mp_physics == wdm5scheme .or. config_flags%mp_physics == wdm6scheme ) THEN ! NO OP - ELSE IF ( config_flags%mp_physics == nssl_2momccn ) THEN - grid%ccn_conc = config_flags%nssl_cccn/1.225 + ELSE IF ( config_flags%mp_physics == nssl_2mom ) THEN + IF ( config_flags%nssl_ccn_is_ccna == 0 ) THEN + grid%ccn_conc = config_flags%nssl_cccn/1.225 + ELSE + grid%ccn_conc = 0 + ENDIF ELSE ! NO OP END IF diff --git a/phys/module_diag_nwp.F b/phys/module_diag_nwp.F index 9879b496a7..336b0cd372 100644 --- a/phys/module_diag_nwp.F +++ b/phys/module_diag_nwp.F @@ -13,6 +13,7 @@ MODULE module_diag_nwp PRIVATE :: GAMMLN CONTAINS SUBROUTINE diagnostic_output_nwp( & + config_flags, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & ips,ipe, jps,jpe, kps,kpe, & ! patch dims @@ -44,15 +45,17 @@ SUBROUTINE diagnostic_output_nwp( & ) !---------------------------------------------------------------------- + USE module_configure, ONLY : grid_config_rec_type + USE module_state_description, ONLY : & KESSLERSCHEME, LINSCHEME, SBU_YLINSCHEME, WSM3SCHEME, WSM5SCHEME, & WSM6SCHEME, ETAMPNEW, THOMPSON, THOMPSONAERO, THOMPSONGH, & MORR_TWO_MOMENT, GSFCGCESCHEME, WDM5SCHEME, WDM6SCHEME, & - NSSL_2MOM, NSSL_2MOMG, NSSL_2MOMCCN, NSSL_1MOM, NSSL_1MOMLFO, & MILBRANDT2MOM , CAMMGMPSCHEME, FULL_KHAIN_LYNN, MORR_TM_AERO, & - FAST_KHAIN_LYNN_SHPUND !,MILBRANDT3MOM, NSSL_3MOM + NSSL_2MOM, FAST_KHAIN_LYNN_SHPUND !,MILBRANDT3MOM USE MODULE_MP_THOMPSON, ONLY: idx_bg1 + IMPLICIT NONE !====================================================================== ! Definitions @@ -106,6 +109,10 @@ SUBROUTINE diagnostic_output_nwp( & ! !====================================================================== + ! We are not changing any of the namelist settings. + + TYPE ( grid_config_rec_type ), INTENT(IN) :: config_flags + INTEGER, INTENT(IN ) :: & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & @@ -378,7 +385,7 @@ SUBROUTINE diagnostic_output_nwp( & !.. graupel category mixing ratio and number concentration (or hail, if !.. available). This diagnostic uses the actual spectral distribution !.. assumptions, calculated by breaking the distribution into 50 bins -!.. from 0.5mm to 7.5cm. Once a minimum number concentration of 0.01 +!.. from 0.5mm to 7.5cm. Once a minimum number concentration of thresh_conc (5e-4) !.. particle per cubic meter of air is reached, from the upper size !.. limit, then this bin is considered the max size. !+---+-----------------------------------------------------------------+ @@ -714,19 +721,26 @@ SUBROUTINE diagnostic_output_nwp( & ! CASE (MILBRANDT3MOM) ! coming in future? - CASE (NSSL_1MOMLFO, NSSL_1MOM, NSSL_2MOM, NSSL_2MOMG, NSSL_2MOMCCN) + CASE (NSSL_2MOM) +! Only treat 1-moment option here. 2- and 3-moment are now done in the microphysics +! + if ( config_flags%nssl_2moment_on == 0 ) then ! single-moment scheme_has_graupel = .true. xrho_g = nssl_rho_qh N0exp = nssl_cnoh - if (PRESENT(qh_curr)) then + if (config_flags%nssl_hail_on==1) then xrho_g = nssl_rho_qhl N0exp = nssl_cnohl endif xam_g = 3.1415926536/6.0*xrho_g - if (PRESENT(ng_curr)) xmu_g = nssl_alphah - if (PRESENT(nh_curr)) xmu_g = nssl_alphahl + + IF (config_flags%nssl_hail_on==1) THEN + xmu_g = nssl_alphahl + ELSE + xmu_g = nssl_alphah + ENDIF if (xmu_g .NE. 0.) then cge(1) = xbm_g + 1. @@ -736,11 +750,14 @@ SUBROUTINE diagnostic_output_nwp( & cgg(n) = WGAMMA(cge(n)) enddo endif + + ENDIF ! NSSL scheme has many options, but, if single-moment, just fill ! in the number array for graupel from built-in assumptions. - if (.NOT.(PRESENT(nh_curr).OR.PRESENT(ng_curr)) ) then +! if (.NOT.(PRESENT(nh_curr).OR.PRESENT(ng_curr)) ) then + if ( config_flags%nssl_2moment_on == 0 ) then ! single-moment ! !$OMP PARALLEL DO & ! !$OMP PRIVATE ( ij ) DO ij = 1 , num_tiles diff --git a/phys/module_diagnostics_driver.F b/phys/module_diagnostics_driver.F index 42c29f49d2..aa583b505f 100644 --- a/phys/module_diagnostics_driver.F +++ b/phys/module_diagnostics_driver.F @@ -39,9 +39,8 @@ SUBROUTINE diagnostics_driver ( grid, config_flags, & KESSLERSCHEME, LINSCHEME, SBU_YLINSCHEME, WSM3SCHEME, WSM5SCHEME, & WSM6SCHEME, ETAMPNEW, THOMPSON, THOMPSONAERO, THOMPSONGH, & MORR_TWO_MOMENT, GSFCGCESCHEME, WDM5SCHEME, WDM6SCHEME, & - NSSL_2MOM, NSSL_2MOMCCN, NSSL_1MOM, NSSL_1MOMLFO, & MILBRANDT2MOM , CAMMGMPSCHEME, FAST_KHAIN_LYNN_SHPUND, FULL_KHAIN_LYNN, & - MORR_TM_AERO !TWG add !,MILBRANDT3MOM, NSSL_3MOM, MORR_MILB_P3 + NSSL_2MOM, MORR_TM_AERO !TWG add !,MILBRANDT3MOM, MORR_MILB_P3 USE module_driver_constants, ONLY: max_plevs, max_zlevs @@ -410,9 +409,10 @@ SUBROUTINE diagnostics_driver ( grid, config_flags, & mp_select: SELECT CASE(config_flags%mp_physics) - CASE (LINSCHEME, WSM6SCHEME, WDM6SCHEME, GSFCGCESCHEME, NSSL_1MOMLFO) + CASE (LINSCHEME, WSM6SCHEME, WDM6SCHEME, GSFCGCESCHEME) - CALL diagnostic_output_nwp( & + CALL diagnostic_output_nwp( & + config_flags=config_flags, & U=grid%u_2 ,V=grid%v_2 & ,TEMP=grid%t_phy ,P8W=p8w & ,DT=grid%dt ,SBW=config_flags%spec_bdy_width & @@ -460,6 +460,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags, & CASE (THOMPSON, THOMPSONAERO) CALL diagnostic_output_nwp( & + config_flags=config_flags, & U=grid%u_2 ,V=grid%v_2 & ,TEMP=grid%t_phy ,P8W=p8w & ,DT=grid%dt ,SBW=config_flags%spec_bdy_width & @@ -509,6 +510,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags, & CASE (THOMPSONGH) CALL diagnostic_output_nwp( & + config_flags=config_flags, & U=grid%u_2 ,V=grid%v_2 & ,TEMP=grid%t_phy ,P8W=p8w & ,DT=grid%dt ,SBW=config_flags%spec_bdy_width & @@ -560,6 +562,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags, & CASE (MORR_TWO_MOMENT, MORR_TM_AERO) ! TWG add CALL diagnostic_output_nwp( & + config_flags=config_flags, & U=grid%u_2 ,V=grid%v_2 & ,TEMP=grid%t_phy ,P8W=p8w & ,DT=grid%dt ,SBW=config_flags%spec_bdy_width & @@ -605,57 +608,11 @@ SUBROUTINE diagnostics_driver ( grid, config_flags, & ,ADAPTIVE_TS=config_flags%use_adaptive_time_step & ) - CASE (NSSL_1MOM) - CALL diagnostic_output_nwp( & - U=grid%u_2 ,V=grid%v_2 & - ,TEMP=grid%t_phy ,P8W=p8w & - ,DT=grid%dt ,SBW=config_flags%spec_bdy_width & - ,XTIME=grid%xtime & - ! Selection flag - ,MPHYSICS_OPT=config_flags%mp_physics & ! gthompsn - ,GSFCGCE_HAIL=config_flags%gsfcgce_hail & ! gthompsn - ,GSFCGCE_2ICE=config_flags%gsfcgce_2ice & ! gthompsn - ,MPUSE_HAIL=config_flags%hail_opt & ! gthompsn - ,NSSL_ALPHAH=config_flags%nssl_alphah & ! gthompsn - ,NSSL_ALPHAHL=config_flags%nssl_alphahl & ! gthompsn - ,NSSL_CNOH=config_flags%nssl_cnoh & ! gthompsn - ,NSSL_CNOHL=config_flags%nssl_cnohl & ! gthompsn - ,NSSL_RHO_QH=config_flags%nssl_rho_qh & ! gthompsn - ,NSSL_RHO_QHL=config_flags%nssl_rho_qhl & ! gthompsn - ,CURR_SECS2=curr_secs2 & - ,NWP_DIAGNOSTICS=config_flags%nwp_diagnostics & - ,DIAGFLAG=diag_flag & - ,HISTORY_INTERVAL=grid%history_interval & - ,ITIMESTEP=grid%itimestep & - ,U10=grid%u10,V10=grid%v10,W=grid%w_2 & - ,WSPD10MAX=grid%wspd10max & - ,UP_HELI_MAX=grid%up_heli_max & - ,W_UP_MAX=grid%w_up_max,W_DN_MAX=grid%w_dn_max & - ,ZNW=grid%znw,W_COLMEAN=grid%w_colmean & - ,NUMCOLPTS=grid%numcolpts,W_MEAN=grid%w_mean & - ,GRPL_MAX=grid%grpl_max,GRPL_COLINT=grid%grpl_colint & - ,REFD_MAX=grid%refd_max & - ,refl_10cm=grid%refl_10cm & - ,HAIL_MAXK1=grid%hail_maxk1,HAIL_MAX2D=grid%hail_max2d & ! gthompsn - ,QG_CURR=moist(ims,kms,jms,P_QG) & - ,QH_CURR=moist(ims,kms,jms,P_QH) & ! gthompsn - ,RHO=grid%rho,PH=grid%ph_2,PHB=grid%phb,G=g & - ! Dimension arguments - ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde & - ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme & - ,IPS=ips,IPE=ipe, JPS=jps,JPE=jpe, KPS=kps,KPE=kpe & - ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) & - ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) & - ,KTS=k_start, KTE=min(k_end,kde-1) & - ,NUM_TILES=grid%num_tiles & - ,MAX_TIME_STEP=grid%max_time_step & - ,ADAPTIVE_TS=config_flags%use_adaptive_time_step & - ) - - CASE (MILBRANDT2MOM, NSSL_2MOM, NSSL_2MOMCCN) + CASE (MILBRANDT2MOM, NSSL_2MOM) CALL diagnostic_output_nwp( & + config_flags=config_flags, & U=grid%u_2 ,V=grid%v_2 & ,TEMP=grid%t_phy ,P8W=p8w & ,DT=grid%dt ,SBW=config_flags%spec_bdy_width & @@ -715,8 +672,6 @@ SUBROUTINE diagnostics_driver ( grid, config_flags, & ! CASE (ETAMPNEW) -! CASE (NSSL_3MOM) - ! CASE (MILBRANDT3MOM) ! CASE (MORR_MILB_P3) @@ -734,6 +689,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags, & CASE DEFAULT CALL diagnostic_output_nwp( & + config_flags=config_flags, & U=grid%u_2 ,V=grid%v_2 & ,TEMP=grid%t_phy ,P8W=p8w & ,DT=grid%dt ,SBW=config_flags%spec_bdy_width & diff --git a/phys/module_microphysics_driver.F b/phys/module_microphysics_driver.F index 7bfcaf901b..57ab8407fd 100644 --- a/phys/module_microphysics_driver.F +++ b/phys/module_microphysics_driver.F @@ -104,6 +104,7 @@ SUBROUTINE microphysics_driver( & ,snownc, snowncv & ,hailnc, hailncv & ,graupelnc, graupelncv & + ,hail_maxk1, hail_max2d & #if ( WRF_CHEM == 1 ) ,rainprod, evapprod & ,qv_b4mp, qc_b4mp, qi_b4mp, qs_b4mp & @@ -166,8 +167,8 @@ SUBROUTINE microphysics_driver( & USE module_state_description, ONLY : & KESSLERSCHEME, LINSCHEME, SBU_YLINSCHEME, WSM3SCHEME, WSM5SCHEME & ,WSM6SCHEME, ETAMPNEW, FER_MP_HIRES, THOMPSON, THOMPSONAERO, THOMPSONGH, FAST_KHAIN_LYNN_SHPUND, MORR_TWO_MOMENT & - ,GSFCGCESCHEME, WDM5SCHEME, WDM6SCHEME, NSSL_2MOM, NSSL_2MOMCCN, NSSL_2MOMG, MADWRF_MP & - ,NSSL_1MOM,NSSL_1MOMLFO, FER_MP_HIRES_ADVECT & ! ,NSSL_3MOM & + ,GSFCGCESCHEME, WDM5SCHEME, WDM6SCHEME, NSSL_2MOM, MADWRF_MP & + ,FER_MP_HIRES_ADVECT & ,WSM7SCHEME, WDM7SCHEME & ,NUWRF4ICESCHEME & ,MILBRANDT2MOM , CAMMGMPSCHEME,FULL_KHAIN_LYNN, P3_1CATEGORY, P3_1CATEGORY_NC, P3_2CATEGORY, P3_1CAT_3MOM & @@ -241,8 +242,9 @@ SUBROUTINE microphysics_driver( & USE module_mp_cammgmp_driver, ONLY: CAMMGMP ! CAM5's microphysics driver # endif ! USE module_mp_milbrandt3mom +#if (WRFPLUS != 1) & !defined( VAR4D ) USE module_mp_nssl_2mom - +#endif USE module_mixactivate, only: prescribe_aerosol_mixactivate ! For checking model timestep is history time (for radar reflectivity) @@ -681,7 +683,8 @@ SUBROUTINE microphysics_driver( & ,GRAUPELNC & ,GRAUPELNCV & ,HAILNC & - ,HAILNCV + ,HAILNCV & + ,hail_maxk1, hail_max2d #if ( WRF_CHEM == 1) ! NUWRF JJS 20110525 vvvvv @@ -799,7 +802,7 @@ SUBROUTINE microphysics_driver( & ENDIF ! set this to true to print out the global max/min for W on each time step. - IF ( .false. ) THEN + IF ( .true. ) THEN wmax = maxval( w(ips:ipe,kps:kpe,jps:jpe) ) wmin = minval( w(ips:ipe,kps:kpe,jps:jpe) ) #if ( defined(DM_PARALLEL) && ! defined(STUBMPI) ) @@ -898,7 +901,7 @@ SUBROUTINE microphysics_driver( & IF( PRESENT(chem_opt) .AND. PRESENT(progn) ) THEN ! ERM: check whether to use built-in droplet nucleation or use qndrop from CHEM - IF ( mp_physics==NSSL_2MOMCCN .or. mp_physics==NSSL_2MOM .or. mp_physics==NSSL_2MOMG ) THEN + IF ( mp_physics==NSSL_2MOM .and. config_flags%nssl_2moment_on==1 ) THEN IF ( progn > 0 ) THEN IF ( .not. (chem_opt == 0 .or. chem_opt == 401) ) nssl_progn = .true. ELSE @@ -923,11 +926,11 @@ SUBROUTINE microphysics_driver( & its,ite, jts,jte, kts,kte, & F_QC=f_qc, F_QI=f_qi ) END IF - ELSEIF ( (chem_opt==0 .OR. chem_opt==401) .AND. progn==1 .AND. (mp_physics==NSSL_2MOMCCN .or. & - mp_physics==NSSL_2MOM .or. mp_physics==NSSL_2MOMG)) THEN + ELSEIF ( (chem_opt==0 .OR. chem_opt==401) .AND. progn==1 .AND. & + (mp_physics==NSSL_2MOM .and. config_flags%nssl_2moment_on==1)) THEN ! Do nothing here for the moment. Use activation of CCN within the NSSL_2MOM scheme instead, based on nssl_cccn namelist value. ELSEIF ( progn==1 .AND. mp_physics/=LINSCHEME .AND. mp_physics/=MORR_TWO_MOMENT & - .AND. mp_physics/=NSSL_2MOM .AND. mp_physics/=NSSL_2MOMCCN .AND. mp_physics/=NSSL_2MOMG ) THEN + .AND. .not. (mp_physics==NSSL_2MOM .and. config_flags%nssl_2moment_on==1) ) THEN call wrf_error_fatal( & "SETTINGS ERROR: Prognostic cloud droplet number can only be used with the mp_physics=LINSCHEME or MORRISON or NSSL_2MOM.") END IF @@ -1926,136 +1929,20 @@ SUBROUTINE microphysics_driver( & ! Call wrf_error_fatal( 'arguments not present for calling milbrandt3mom') ! ENDIF - CASE (NSSL_1MOM) - CALL wrf_debug(100, 'microphysics_driver: calling nssl1mom') - IF (PRESENT (QV_CURR) .AND. & - PRESENT (QC_CURR) .AND. & - PRESENT (QR_CURR) .AND. & - PRESENT (QI_CURR) .AND. & - PRESENT (QS_CURR) .AND. & - PRESENT (QG_CURR) .AND. & - PRESENT (QH_CURR) .AND. & - PRESENT (RAINNC ) .AND. PRESENT (RAINNCV) .AND. & -#if (EM_CORE==1) - PRESENT (SNOWNC ) .AND. PRESENT (SNOWNCV) .AND. & - PRESENT (HAILNC ) .AND. PRESENT (HAILNCV) .AND. & - PRESENT (GRAUPELNC).AND.PRESENT (GRAUPELNCV).AND. & -#endif - PRESENT ( W ) .AND. & - PRESENT (QVOLG_CURR) ) THEN - - CALL nssl_2mom_driver( & - ITIMESTEP=itimestep, & - TH=th, & - QV=qv_curr, & - QC=qc_curr, & - QR=qr_curr, & - QI=qi_curr, & - QS=qs_curr, & - QH=qg_curr, & - QHL=qh_curr, & -! CCW=qnc_curr, & -! CRW=qnr_curr, & -! CCI=qni_curr, & -! CSW=qns_curr, & -! CHW=qng_curr, & -! CHL=qnh_curr, & - VHW=qvolg_curr, & - PII=pi_phy, & - P=p, & - W=w, & - DZ=dz8w, & - DTP=dt, & - DN=rho, & - RAINNC = RAINNC, & - RAINNCV = RAINNCV, & - SNOWNC = SNOWNC, & - SNOWNCV = SNOWNCV, & - HAILNC = HAILNC, & - HAILNCV = HAILNCV, & - GRPLNC = GRAUPELNC, & - GRPLNCV = GRAUPELNCV, & - SR=SR, & - dbz = refl_10cm, & - diagflag = diagflag, & - ke_diag = ke_diag, & - IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde, & - IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme, & - ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte & - ) - ELSE - Call wrf_error_fatal( 'arguments not present for calling nssl_1mom') - ENDIF - - - CASE (NSSL_1MOMLFO) - CALL wrf_debug(100, 'microphysics_driver: calling nssl1mom') - IF (PRESENT (QV_CURR) .AND. & - PRESENT (QC_CURR) .AND. & - PRESENT (QR_CURR) .AND. & - PRESENT (QI_CURR) .AND. & - PRESENT (QS_CURR) .AND. & - PRESENT (QG_CURR) .AND. & - PRESENT (RAINNC ) .AND. PRESENT (RAINNCV) .AND. & -#if (EM_CORE==1) - PRESENT (SNOWNC ) .AND. PRESENT (SNOWNCV) .AND. & - PRESENT (GRAUPELNC).AND.PRESENT (GRAUPELNCV).AND. & -#endif - PRESENT ( W ) ) THEN - - - CALL nssl_2mom_driver( & - ITIMESTEP=itimestep, & - TH=th, & - QV=qv_curr, & - QC=qc_curr, & - QR=qr_curr, & - QI=qi_curr, & - QS=qs_curr, & - QH=qg_curr, & - PII=pi_phy, & - P=p, & - W=w, & - DZ=dz8w, & - DTP=dt, & - DN=rho, & - RAINNC = RAINNC, & - RAINNCV = RAINNCV, & - SNOWNC = SNOWNC, & - SNOWNCV = SNOWNCV, & - GRPLNC = GRAUPELNC, & - GRPLNCV = GRAUPELNCV, & - SR=SR, & - dbz = refl_10cm, & - diagflag = diagflag, & - ke_diag = ke_diag, & - IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde, & - IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme, & - ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte & - ) - ELSE - Call wrf_error_fatal( 'arguments not present for calling nssl_1momlfo') - ENDIF CASE (NSSL_2MOM) +#if (WRFPLUS != 1) & !defined( VAR4D ) + ! For all 1,2,3-moment options CALL wrf_debug(100, 'microphysics_driver: calling nssl2mom') IF (PRESENT (QV_CURR) .AND. & - PRESENT (QC_CURR) .AND. PRESENT (QNdrop_CURR) .AND. & - PRESENT (QR_CURR) .AND. PRESENT (QNR_CURR) .AND. & - PRESENT (QI_CURR) .AND. PRESENT (QNI_CURR) .AND. & - PRESENT (QS_CURR) .AND. PRESENT (QNS_CURR) .AND. & - PRESENT (QG_CURR) .AND. PRESENT (QNG_CURR) .AND. & - PRESENT (QH_CURR) .AND. PRESENT (QNH_CURR) .AND. & PRESENT (RAINNC ) .AND. PRESENT (RAINNCV) .AND. & #if (EM_CORE==1) PRESENT (SNOWNC ) .AND. PRESENT (SNOWNCV) .AND. & PRESENT (HAILNC ) .AND. PRESENT (HAILNCV) .AND. & PRESENT (GRAUPELNC).AND.PRESENT (GRAUPELNCV).AND. & #endif - PRESENT ( W ) .AND. & - PRESENT (QVOLG_CURR) .AND. F_QVOLG .AND. & - PRESENT (QVOLH_CURR) .AND. F_QVOLH ) THEN + PRESENT ( W ) ) THEN CALL nssl_2mom_driver( & @@ -2075,8 +1962,12 @@ SUBROUTINE microphysics_driver( & CSW=qns_curr, & CHW=qng_curr, & CHL=qnh_curr, & - VHW=qvolg_curr, & - VHL=qvolh_curr, & + VHW=qvolg_curr, f_vhw=F_QVOLG, & + VHL=qvolh_curr, f_vhl=F_QVOLH, & + ZRW=qzr_curr, f_zrw = f_qzr, & + ZHW=qzg_curr, f_zhw = f_qzg, & + ZHL=qzh_curr, f_zhl = f_qzh, & + cn=qnn_curr, f_cn=f_qnn, & PII=pi_phy, & P=p, & W=w, & @@ -2111,6 +2002,9 @@ SUBROUTINE microphysics_driver( & has_reqc=has_reqc, & ! ala G. Thompson has_reqi=has_reqi, & ! ala G. Thompson has_reqs=has_reqs, & ! ala G. Thompson + hail_maxk1=hail_maxk1, & + hail_max2d=hail_max2d, & + nwp_diagnostics=config_flags%nwp_diagnostics, & IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde, & IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme, & ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte & @@ -2119,165 +2013,7 @@ SUBROUTINE microphysics_driver( & ELSE Call wrf_error_fatal( 'arguments not present for calling nssl_2mom') ENDIF - - CASE (NSSL_2MOMG) - CALL wrf_debug(100, 'microphysics_driver: calling nssl2mom') - IF (PRESENT (QV_CURR) .AND. & - PRESENT (QC_CURR) .AND. PRESENT (QNdrop_CURR) .AND. & - PRESENT (QR_CURR) .AND. PRESENT (QNR_CURR) .AND. & - PRESENT (QI_CURR) .AND. PRESENT (QNI_CURR) .AND. & - PRESENT (QS_CURR) .AND. PRESENT (QNS_CURR) .AND. & - PRESENT (QG_CURR) .AND. PRESENT (QNG_CURR) .AND. & - PRESENT (RAINNC ) .AND. PRESENT (RAINNCV) .AND. & -#if (EM_CORE==1) - PRESENT (SNOWNC ) .AND. PRESENT (SNOWNCV) .AND. & - PRESENT (HAILNC ) .AND. PRESENT (HAILNCV) .AND. & - PRESENT (GRAUPELNC).AND.PRESENT (GRAUPELNCV).AND. & -#endif - PRESENT ( W ) .AND. & - PRESENT (QVOLG_CURR) .AND. F_QVOLG ) THEN - - - CALL nssl_2mom_driver( & - ITIMESTEP=itimestep, & - TH=th, & - QV=qv_curr, & - QC=qc_curr, & - QR=qr_curr, & - QI=qi_curr, & - QS=qs_curr, & - QH=qg_curr, & - ! CCW=qnc_curr, & - CCW=qndrop_curr, & - CRW=qnr_curr, & - CCI=qni_curr, & - CSW=qns_curr, & - CHW=qng_curr, & - VHW=qvolg_curr, & - PII=pi_phy, & - P=p, & - W=w, & - DZ=dz8w, & - DTP=dt, & - DN=rho, & - RAINNC = RAINNC, & - RAINNCV = RAINNCV, & - SNOWNC = SNOWNC, & - SNOWNCV = SNOWNCV, & - HAILNC = HAILNC, & - HAILNCV = HAILNCV, & - GRPLNC = GRAUPELNC, & - GRPLNCV = GRAUPELNCV, & - SR=SR, & - dbz = refl_10cm, & -#if ( WRF_CHEM == 1 ) - WETSCAV_ON = config_flags%wetscav_onoff == 1, & - EVAPPROD=evapprod,RAINPROD=rainprod, & -#endif - nssl_progn=nssl_progn, & - diagflag = diagflag, & - cu_used=cu_used, & - qrcuten=qrcuten, & ! hm - qscuten=qscuten, & ! hm - qicuten=qicuten, & ! hm - qccuten=qccuten, & ! hm - re_cloud=re_cloud, & - re_ice=re_ice, & - re_snow=re_snow, & - has_reqc=has_reqc, & ! ala G. Thompson - has_reqi=has_reqi, & ! ala G. Thompson - has_reqs=has_reqs, & ! ala G. Thompson - IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde, & - IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme, & - ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte & - ) - - ELSE - Call wrf_error_fatal( 'arguments not present for calling nssl_2momg') - ENDIF - - CASE (NSSL_2MOMCCN) - CALL wrf_debug(100, 'microphysics_driver: calling nssl_2momccn') - IF (PRESENT (QV_CURR) .AND. & - PRESENT (QC_CURR) .AND. PRESENT (QNDROP_CURR) .AND. & - PRESENT (QR_CURR) .AND. PRESENT (QNR_CURR) .AND. & - PRESENT (QI_CURR) .AND. PRESENT (QNI_CURR) .AND. & - PRESENT (QS_CURR) .AND. PRESENT (QNS_CURR) .AND. & - PRESENT (QG_CURR) .AND. PRESENT (QNG_CURR) .AND. & - PRESENT (QH_CURR) .AND. PRESENT (QNH_CURR) .AND. & - PRESENT (RAINNC ) .AND. PRESENT (RAINNCV) .AND. & -#if (EM_CORE==1) - PRESENT (SNOWNC ) .AND. PRESENT (SNOWNCV) .AND. & - PRESENT (HAILNC ) .AND. PRESENT (HAILNCV) .AND. & - PRESENT (GRAUPELNC).AND.PRESENT (GRAUPELNCV).AND. & #endif - PRESENT ( W ) .AND. & - PRESENT (QVOLG_CURR) .AND. F_QVOLG .AND. & - PRESENT (QVOLH_CURR) .AND. F_QVOLH .AND. & - PRESENT( QNN_CURR ) ) THEN - - - CALL nssl_2mom_driver( & - ITIMESTEP=itimestep, & - TH=th, & - QV=qv_curr, & - QC=qc_curr, & - QR=qr_curr, & - QI=qi_curr, & - QS=qs_curr, & - QH=qg_curr, & - QHL=qh_curr, & -! CCW=qnc_curr, & - CCW=qndrop_curr, & - CRW=qnr_curr, & - CCI=qni_curr, & - CSW=qns_curr, & - CHW=qng_curr, & - CHL=qnh_curr, & - VHW=qvolg_curr, & - VHL=qvolh_curr, & - cn=qnn_curr, & - PII=pi_phy, & - P=p, & - W=w, & - DZ=dz8w, & - DTP=dt, & - DN=rho, & - RAINNC = RAINNC, & - RAINNCV = RAINNCV, & - SNOWNC = SNOWNC, & - SNOWNCV = SNOWNCV, & - HAILNC = HAILNC, & - HAILNCV = HAILNCV, & - GRPLNC = GRAUPELNC, & - GRPLNCV = GRAUPELNCV, & - SR=SR, & - dbz = refl_10cm, & -#if ( WRF_CHEM == 1 ) - WETSCAV_ON = config_flags%wetscav_onoff == 1, & - EVAPPROD=evapprod,RAINPROD=rainprod,& -#endif - nssl_progn=nssl_progn, & - diagflag = diagflag, & - ke_diag = ke_diag, & - cu_used=cu_used, & - qrcuten=qrcuten, & ! hm - qscuten=qscuten, & ! hm - qicuten=qicuten, & ! hm - qccuten=qccuten, & ! hm - re_cloud=re_cloud, & - re_ice=re_ice, & - re_snow=re_snow, & - has_reqc=has_reqc, & ! ala G. Thompson - has_reqi=has_reqi, & ! ala G. Thompson - has_reqs=has_reqs, & ! ala G. Thompson - IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde, & - IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme, & - ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte & - ) - ELSE - Call wrf_error_fatal( 'arguments not present for calling nssl_2momccn') - ENDIF ! CASE (GSFCGCESCHEME) CALL wrf_debug ( 100 , 'microphysics_driver: calling GSFCGCE' ) diff --git a/phys/module_mp_nssl_2mom.F b/phys/module_mp_nssl_2mom.F index 10d5f1cd51..d89baf3571 100644 --- a/phys/module_mp_nssl_2mom.F +++ b/phys/module_mp_nssl_2mom.F @@ -1,8 +1,6 @@ !WRF:MODEL_LAYER:PHYSICS - -! prepocessed on "Sep 7 2021" at "19:37:43" - +! prepocessed on "Aug 14 2023" at "16:15:23" @@ -25,35 +23,33 @@ ! ! WENO references: Jiang and Shu, 1996, J. Comp. Phys. v. 126, 202-223; Shu 2003, Int. J. Comp. Fluid Dyn. v. 17 107-118; ! -! This module provides a 2-moment bulk microphysics scheme originally -! developed by Conrad Ziegler (Zeigler, 1985, JAS) and modified/upgraded in -! in Mansell, Zeigler, and Bruning (2010, JAS). Two-moment adaptive sedimentation -! follows Mansell (2010, JAS), using parameter infall = 4. -! -! Added info on graupel density and soaking is in Mansell and Ziegler (2013, JAS) -! -! Average graupel particle density is predicted, which affects fall speed as well. -! Hail density prediction is by default disabled in this version, but may be enabled -! at some point if there is interest. -! -! Maintainer: Ted Mansell, National Severe Storms Laboratory -! -! Microphysics References: -! -! Mansell, E. R., C. L. Ziegler, and E. C. Bruning, 2010: Simulated electrification of a small -! thunderstorm with two-moment bulk microphysics. J. Atmos. Sci., 67, 171-194, doi:10. 1175/2009JAS2965.1. -! -! Mansell, E. R. and C. L. Ziegler, 2013: Aerosol effects on simulated storm electrification and -! precipitation in a two-moment bulk microphysics model. J. Atmos. Sci., 70 (7), 2032-2050, -! doi:10.1175/JAS-D-12-0264.1. -! -! Ziegler, C. L., 1985: Retrieval of thermal and microphysical variables in observed convective storms. -! Part I: Model development and preliminary testing. J. Atmos. Sci., 42, 1487-1509. -! -! Sedimentation reference: -! -! Mansell, E. R., 2010: On sedimentation and advection in multimoment bulk microphysics. -! J. Atmos. Sci., 67, 3084-3094, doi:10.1175/2010JAS3341.1. +!! This module provides a 1/2/3-moment bulk microphysics scheme based on a combination of +!! Straka and Mansell (2005, JAM) and Zeigler (1985, JAS) and modified/upgraded in +!! in Mansell, Zeigler, and Bruning (2010, JAS). Two-moment adaptive sedimentation +!! follows Mansell (2010, JAS), using parameter infall = 4. +!! +!! Added info on graupel density and soaking is in Mansell and Ziegler (2013, JAS) +!! +!! Average graupel and hail particle densities are predicted, which affects fall speed as well. +!! +!! Maintainer: Ted Mansell, National Severe Storms Laboratory +!! +!! Microphysics References: +!! +!! Mansell, E. R., C. L. Ziegler, and E. C. Bruning, 2010: Simulated electrification of a small +!! thunderstorm with two-moment bulk microphysics. J. Atmos. Sci., 67, 171-194, doi:10. 1175/2009JAS2965.1. +!! +!! Mansell, E. R. and C. L. Ziegler, 2013: Aerosol effects on simulated storm electrification and +!! precipitation in a two-moment bulk microphysics model. J. Atmos. Sci., 70 (7), 2032-2050, +!! doi:10.1175/JAS-D-12-0264.1. +!! +!! Ziegler, C. L., 1985: Retrieval of thermal and microphysical variables in observed convective storms. +!! Part I: Model development and preliminary testing. J. Atmos. Sci., 42, 1487-1509. +!! +!! Sedimentation reference: +!! +!! Mansell, E. R., 2010: On sedimentation and advection in multimoment bulk microphysics. +!! J. Atmos. Sci., 67, 3084-3094, doi:10.1175/2010JAS3341.1. ! ! Possible parameters to adjust: ! @@ -66,18 +62,26 @@ ! Fierro, A. O., E.R. Mansell, C. Ziegler and D. R. MacGorman 2013: The ! implementation of an explicit charging and discharge lightning scheme ! within the WRF-ARW model: Benchmark simulations of a continental squall line, a -! tropical cyclone and a winter storm. Monthly Weather Review, Volume 141, 2390-2415 +! tropical cyclone and a winter storm. Monthly Weather Review, Volume 141, 2390-2415 ! -! Mansell et al. 2005: Charge structure and lightning sensitivity in a simulated +! Mansell et al. 2005: Charge structure and lightning sensitivity in a simulated ! multicell thunderstorm. J. Geophys. Res., 110, D12101, doi:10.1029/2004JD005287 ! ! Note: Some parameters below apply to unreleased features. ! ! !--------------------------------------------------------------------- +! Apr. 2023 (WRF-4.6) +! - Update to 3-moment for rain, graupel, and hail +! - Change default graupel/hail fall speeds to icdx/icdxhl=6 (Milbrandt & Morrison 2013) +! and also set default ehw0=0.9 and ehlw0=0.9 to compensate for lower fall speeds. +! - Change default hail conversion to ihlcnh=-1, and then =1 for 2-mom or =3 for 3-mom, +! using wet growth diameter to convert large graupel +!--------------------------------------------------------------------- ! Sept. 2021: ! Fixes: -! Restored previous formulation of snow reflectivity, as it was realized that the last change incorrectly assumed a fixed density independent of size. Generally lower snow reflectivity values as a result (no effect on microphysics) +! Restored previous formulation of snow reflectivity, as it was realized that the last change incorrectly assumed a fixed +! density independent of size. Generally lower snow reflectivity values as a result (no effect on microphysics) ! Other: ! Generic fall speed coeffecients (axx,bxx) to accomodate future frozen drops category (no effect) ! Reordered collection coefficients (dab1lh) to be consistent (no effect) @@ -169,7 +173,6 @@ MODULE module_mp_nssl_2mom - IMPLICIT NONE public nssl_2mom_driver @@ -212,14 +215,13 @@ MODULE module_mp_nssl_2mom integer :: iusewetgraupel = 1 ! =1 to turn on use of QHW for graupel reflectivity (only for ZVDM -- mixedphase) ! =2 turn on for graupel density less than 300. only integer :: iusewethail = 0 ! =1 to turn on use of QHW for graupel reflectivity (only for ZVDM -- mixedphase) - integer :: iusewetsnow = 1 ! =1 to turn on diagnosed bright band; =2 'old' snow reflectivity (dry), =3 'old' snow dbz + brightband - + integer :: iusewetsnow = 0 ! =1 to turn on diagnosed bright band; =2 'old' snow reflectivity (dry), =3 'old' snow dbz + brightband ! microphysics real, private :: rho_qr = 1000., cnor = 8.0e5 ! cnor is set in namelist!! rain params real, private :: rho_qs = 100., cnos = 3.0e6 ! set in namelist!! snow params real, private :: rho_qh = 500., cnoh = 4.0e5 ! set in namelist!! graupel params - real, private :: rho_qhl= 900., cnohl = 4.0e4 ! set in namelist!! hail params + real, private :: rho_qhl= 800., cnohl = 4.0e4 ! set in namelist!! hail params real, private :: hdnmn = 170.0 ! minimum graupel density (for variable density graupel) real, private :: hldnmn = 500.0 ! minimum hail density (for variable density hail) @@ -232,8 +234,10 @@ MODULE module_mp_nssl_2mom real , private :: qcmincwrn = 2.0e-3 ! qc threshold for autonconversion (LFO; for 10ICE use qminrncw for ircnw != 5) real , private :: cwdiap = 20.0e-6 ! threshold diameter of cloud drops (Ferrier 1994 autoconversion) real , private :: cwdisp = 0.15 ! assume droplet dispersion parameter (can be 0.3 for maritime) - real , private :: ccn = 0.6e+09 ! set in namelist!! Central plains CCN value - real , public :: qccn ! ccn "mixing ratio" + real , private :: ccn = 0.6e+09 ! set in namelist!! Central plains CCN value + real , private :: ccnuf = 0 ! set in namelist!! Central plains CCN value + real , public :: qccn, qccnuf ! ccn "mixing ratio" + real , private :: old_qccn = -1.0 integer, private :: iauttim = 1 ! 10-ice rain delay flag real , private :: auttim = 300. ! 10-ice rain delay time real , private :: qcwmntim = 1.0e-5 ! 10-ice rain delay min qc for time accrual @@ -242,10 +246,17 @@ MODULE module_mp_nssl_2mom ! NMM WRF core does not have special boundary conditions for CCN, therefore set invertccn to true logical, parameter :: invertccn = .true. ! =true for base state of ccn=0, =false for ccn initialized in the base state #else - logical, parameter :: invertccn = .false. ! =true for base state of ccn=0, =false for ccn initialized in the base state + logical, private :: invertccn = .false. ! =true for base state of ccn=0, =false for ccn initialized in the base state #endif + logical :: switchccn = .false. + real :: old_cccn = -1.0 logical :: restoreccn = .true. ! whether or not to nudge CCN back to base state (qccn) (only applies if CCNA is NOT predicted) real :: ccntimeconst = 3600. ! time constant for CCN restore (either for CCNA or when restoreccn = true) + real, private :: restoreccnfrac = 1.0 ! fraction of evaporated droplets that restore CCN + real :: ufccntimeconst = 6.*3600. ! time constant for UFCCN decay (Blossey et al. 2018) + real :: ufbackground = 0.1e9 ! background ccnuf value (Blossey et al.) + logical :: decayufccn = .false. + integer :: i_uf_or_ccn = 0 ! 0 = ship adds UF; 1 = treat UF as regular ccn (add to qccn) ! sedimentation flags ! itfall -> 0 = 1st order fallout (other options removed) @@ -254,6 +265,7 @@ MODULE module_mp_nssl_2mom integer, private :: itfall = 0 integer, private :: iscfall = 1 integer, private :: irfall = -1 + integer, private :: isfall = 2 ! default limit with method II (more restrictive) logical, private :: do_accurate_sedimentation = .false. ! if true, recalculate fall speeds on sub time steps; (more expensive) ! if false, reuse fall speeds on multiple steps (can have a noticeable speedup) ! Mainly is an issue for small dz near the surface. @@ -264,14 +276,20 @@ MODULE module_mp_nssl_2mom ! 3 -> uses number-wgt for N and Z-weighted correction for N (Method I in Mansell, 2010 JAS) ! 4 -> Hybrid of 2 and 3: Uses minimum N from each method (z-wgt and m-wgt corrections) (Method I+II in Mansell, 2010 JAS) ! 5 -> uses number-wgt for N and uses average of N-wgt and q-wgt instead of Max. + integer :: imydiagalpha = 0 ! apply MY diagnostic shape parameter for fall speeds (1=for fall speed only; 2=also for microphysics rates) real, private :: rainfallfac = 1.0 ! factor to adjust rain fall speed (single moment only) real, private :: icefallfac = 1.0 ! factor to adjust ice fall speed real, private :: snowfallfac = 1.0 ! factor to adjust snow fall speed real, private :: graupelfallfac = 1.0 ! factor to adjust graupel fall speed real, private :: hailfallfac = 1.0 ! factor to adjust hail fall speed integer, private :: icefallopt = 3 ! 1= default, 2 = Ferrier ice fall speed; 3 = adjusted Ferrier (slightly high Vt) - integer, private :: icdx = 3 ! (graupel) 0=Ferrier; 1=leave drag coef. cd fixed; 2=vary by density, 4=set by user with cdxmin,cdxmax,etc. - integer, private :: icdxhl = 3 ! (hail) 0=Ferrier; 1=leave drag coef. cd fixed; 2=vary by density, 4=set by user with cdxmin,cdxmax,etc. + integer, private :: icdx = 6 ! (graupel) 0=Ferrier; 1=leave drag coef. cd fixed; 2=vary by density, 4=set by user with cdxmin,cdxmax,etc. + ! 6= Milbrandt and Morrison (2013) density-based fall speed + integer, private :: icdxhl = 6 ! (hail) 0=Ferrier; 1=leave drag coef. cd fixed; 2=vary by density, 4=set by user with cdxmin,cdxmax,etc. + ! 6= Milbrandt and Morrison (2013) density-based fall speed + real :: axh = 75.7149, bxh = 0.5 + real :: axf = 75.7149, bxf = 0.5 + real :: axhl = 206.984, bxhl = 0.6384 real , private :: cdhmin = 0.45, cdhmax = 0.8 ! defaults for graupel (icdx=4) real , private :: cdhdnmin = 500., cdhdnmax = 800.0 ! defaults for graupel (icdx=4) real , private :: cdhlmin = 0.45, cdhlmax = 0.6 ! defaults for hail (icdx=4) @@ -305,7 +323,7 @@ MODULE module_mp_nssl_2mom integer, private :: irimtim = 0 ! future use ! integer, private :: infdo = 1 ! 1 = calculate number-weighted fall speeds - integer, private :: irimdenopt = 1 ! = 1 for default Macklin; = 2 for experimental Cober and List (1993) + integer, private :: irimdenopt = 1 ! = 1 for default Heymsfield and Pflaum (1985); = 2 for experimental Cober and List (1993); = 3 Macklin real , private :: rimc1 = 300.0, rimc2 = 0.44 ! rime density coeff. and power (Default Heymsfield and Pflaum, 1985) real , private :: rimc3 = 170.0 ! minimum rime density real :: rimc4 = 900.0 ! maximum rime density @@ -320,7 +338,7 @@ MODULE module_mp_nssl_2mom ! (first nucleation is done with a KW sat. adj. step) integer, private :: issfilt = 0 ! flag to turn on filtering of supersaturation field integer, private :: icnuclimit = 0 ! limit droplet nucleation based on Konwar et al. (2012) and Chandrakar et al. (2016) - integer, private :: irenuc = 2 ! =1 to always allow renucleation of droplets within the cloud + integer, private :: irenuc = 2 ! =1 to always allow renucleation of droplets within the cloud (do no use, obsolete) ! =2 renucleation following Twomey/Cohard&Pinty ! =7 New renucleation that requires prediction of the number of activated nuclei ! i.e., not only at cloud base @@ -342,6 +360,7 @@ MODULE module_mp_nssl_2mom ! 0,2, 5.00e-10, 1, 0, 0, 0 : itype1,itype2,cimas0,icfn,ihrn,ibfc,iacr integer, private :: itype1 = 0, itype2 = 2 ! controls Hallett-Mossop process + integer, private :: in_freeze_rain_first = 0 ! =1 use IN to freezed rain drops (if none, then freeze droplets) integer, private :: icenucopt = 1 ! =1 Meyers/Ferrier primary ice nucleation; =2 Thompson/Cooper, =3 Phillips (Meyers/Demott), =4 DeMott (2010) real, private :: naer = 1.0e6 ! background large aerosol conc. for DeMott integer, private :: icfn = 2 ! contact freezing: 0 = off; 1 = hack (ok for single moment); 2 = full Cotton/Meyers version @@ -352,7 +371,9 @@ MODULE module_mp_nssl_2mom integer, private :: iremoveqwfrz = 1 ! Whether to remove (=1) or not (=0) the newly-frozen cloud droplets (ibfc=1) from the CWC used for charge separation integer, private :: iacr = 2 ! Flag for drop contact freezing with crytals ! (0=off; 1=drops > 500micron diameter; 2 = > 300micron) + integer, private :: icrcev = 1 ! 1 = old crcev; 2 = crcev scaled by vtrain ratio (num/mass); 3 = set to zero integer, private :: icracr = 1 ! Flag to turn rain self-collection on/off (=0 to turn off) + integer, private :: icracrthresh = 1 ! For rain self-coll. thresh. use: 1 = mean diam of 2mm; 2 = rain median volume diam of 1.9mm integer, private :: ibfr = 2 ! Flag for Bigg freezing conversion of freezing drops to graupel ! (1=min graupel size is vr1mm; 2=use min size of dfrz, 5= as for 2 and apply dbz conservation) integer, private :: ibiggopt = 2 ! 1 = old Bigg; 2 = experimental Bigg (only for imurain = 1, however) @@ -379,9 +400,9 @@ MODULE module_mp_nssl_2mom integer, private :: ierw = 1 ! for single-moment rain (LFO/Z) integer, private :: iehr0c = 0 ! 0 -> no collection for T > 0C; 1 -> turn on collection/shedding for T > 0C integer, private :: iehlr0c = 0 ! 0 -> no collection for T > 0C; 1 -> turn on collection/shedding for T > 0C - real , private :: ehw0 = 0.5 ! constant or max assumed graupel-droplet collection efficiency + real , private :: ehw0 = 0.9 ! 0.5 ! constant or max assumed graupel-droplet collection efficiency real , private :: erw0 = 1.0 ! constant assumed rain-droplet collection efficiency - real , private :: ehlw0 = 0.75 ! constant or max assumed hail-droplet collection efficiency + real , private :: ehlw0 = 0.9 ! 0.75 ! constant or max assumed hail-droplet collection efficiency real , private :: efw0 = 0.5 ! constant or max assumed graupel-droplet collection efficiency real :: ehr0 = 1.0 ! constant or max assumed graupel-rain collection efficiency real :: efr0 = 1.0 ! constant or max assumed graupel-rain collection efficiency @@ -408,15 +429,19 @@ MODULE module_mp_nssl_2mom ! set eii1 = 0 to get a constant value of eii0 real , private :: eii0hl = 0.2 ,eii1hl = 0.0 ! hail-crystal coll. eff. parameters: eii0hl*exp(eii1hl*min(temcg(mgs),0.0)) ! set eii1hl = 0 to get a constant value of eii0hl + real, private :: ewi_dcmin = 15.0e-06 ! minimum droplet diameter for nonzero ewi + real, private :: ewi_dimin = 30.0e-06 ! minimum ice crystal diameter for nonzero ewi real , private :: eri0 = 0.1 ! rain efficiency to collect ice crystals real , private :: eri_cimin = 10.e-6 ! minimum ice crystal diameter for collection by rain real , private :: esi0 = 0.1 ! linear factor in snow-ice collection efficiency real , private :: ehs0 = 0.1, ehs1 = 0.1 ! graupel-snow coll. eff. parameters: ehs0*exp(ehs1*min(temcg(mgs),0.0)) ! set ehs1 = 0 to get a constant value of ehs0 - real , private :: ess0 = 1.0, ess1 = 0.05 ! snow aggregation coefficients: ess0*exp(ess1*min(temcg(mgs),0.0)) + integer :: iessopt = 1 ! 1 = Original (no factor); 2 = factor based on wvel; 3 = factor based on SSI + ! 4 = as 3 but sets min factor of 0.1 and goes to full value at 0.5% SSI + real , private :: ess0 = 0.5, ess1 = 0.05 ! snow aggregation coefficients: ess0*exp(ess1*min(temcg(mgs),0.0)) ! set ess1 = 0 to get a constant value of ess0 - real , private :: esstem1 = -25. ! lower temperature where snow aggregation turns on - real , private :: esstem2 = -20. ! higher temperature for linear ramp of ess from zero at esstem1 to formula value at esstem2 + real , private :: esstem1 = -15. ! lower temperature where snow aggregation turns on + real , private :: esstem2 = -10. ! higher temperature for linear ramp of ess from zero at esstem1 to formula value at esstem2 real , private :: essrmax = 0.02 ! maximum snow radius (meters) for csacs real , private :: essfrac1 = 0.5 ! snow mass fraction 1 for aggregation roll-off real , private :: essfrac2 = 0.75 ! snow mass fraction 2 for aggregation roll-off @@ -447,11 +472,13 @@ MODULE module_mp_nssl_2mom ! 0 = no condensation on rain; 1 = bulk condensation on rain integer, parameter, private :: icond = 1 ! (Z only) icond = 1 calculates ice deposition (crystals and snow) BEFORE droplet condensation ! icond = 2 does not work (intended to calc. dep in loop with droplet cond.) + integer, private :: iqis0 = 2 ! = 1 for normal qis; = 2 to set qis to use T = 0C when T > 0C real , private :: dfrz = 0.15e-3 ! 0.25e-3 ! minimum diameter of frozen drops from Bigg freezing (used for vfrz) for iacr > 1 ! and for ciacrf for iacr=4 real , private :: dmlt = 3.0e-3 ! maximum diameter for rain melting from graupel and hail real , private :: dshd = 1.0e-3 ! nominal diameter for rain drops shed from graupel/hail + integer, private :: ivshdgs = 1 ! 0 = use 1mm for all shedding (non-mixedphase); 1 = use vshdgs with sheddiam integer, private :: ished2cld = 0 ! 1: Send shed liquid (from wet growth) to cloud droplets integer, private :: ihmlt = 2 ! 1=old melting with vmlt; 2=new melting using mean volume diam of graupel/hail @@ -475,6 +502,7 @@ MODULE module_mp_nssl_2mom real, private :: qhdpvdn = -1. real, private :: qhacidn = -1. + integer, private :: iraintypes = 0 logical, private :: mixedphase = .false. ! .false.=off, true=on to include mixed phase graupel integer, private :: imixedphase = 0 logical, private :: qsdenmod = .false. ! true = modify snow density by linear interpolation of snow and rain density @@ -506,17 +534,23 @@ MODULE module_mp_nssl_2mom real, parameter :: alpharmax = 8. ! limited for rwvent calculation - integer, private :: ihlcnh = 1 ! which graupel -> hail conversion to use + integer, private :: ihlcnh = -1 ! which graupel -> hail conversion to use ! 1 = Milbrandt and Yau (2005) using Ziegler 1985 wet growth diameter ! 2 = Straka and Mansell (2005) conversion using size threshold + ! 3 = Conversion using wet growth diameter real, private :: hlcnhdia = 1.e-3 ! threshold diameter for graupel -> hail conversion for ihlcnh = 1 option. real, private :: hlcnhqmin = 0.1e-3 ! minimum graupel mass content for graupel -> hail conversion (ihlcnh = 1) - real , private :: hldia1 = 20.0e-3 ! threshold diameter for graupel -> hail conversion for ihlcnh = 2 option. + real , private :: hldia1 = 10.0e-3 ! threshold diameter for graupel -> hail conversion for ihlcnh = 2 option. + integer, private :: incwet = 0 ! flag to do wet growth only on D > D_wet integer, private :: iusedw = 0 ! flag to use experimental wet growth ice diameter for gr -> hl conversion (=1 turns on) - real , private :: dwmin = 0.0 ! Minimum diameter with iusedw (can stay at 0 or be set to something larger) + real , private :: dwmin = 5.0e-3 ! Minimum diameter with iusedw (can stay at 0 or be set to something larger) + real , private :: dwetmin = 5.0e-3 ! Minimum diameter with iusedw (can stay at 0 or be set to something larger) + real , private :: dwmax = 15.e-3 ! for ihlcnh, always convert this size and larger whether or not there is wet growth real , private :: dwtempmin = 242. ! lowest temperature to allow wet growth conversion to hail real , private :: dwehwmin = 0. ! Minimum ehw to use to find wet growth diameter (if > ehw0, then wet growth diam becomes smaller) real , private :: dg0thresh = 0.15 ! graupel wet growth diameter above which we say do not bother + integer :: ifddenfac = 0 ! = 1 to use density threshold to count FD as GR when converting to HL + real :: fddenthresh = 500. ! if ifddenfac > 0, then hail from FD with lower density are considered to come from graupel integer :: icvhl2h = 0 ! allow conversion of hail back to graupel when hail density gets close to minimum allowed integer, private :: imurain = 1 ! 3 for gamma-volume, 1 for gamma-diameter DSD for rain. @@ -533,6 +567,8 @@ MODULE module_mp_nssl_2mom ! = 1 use mean diameter for breakup ! = 2 use maximum mass diameter for breakup ! = 3 use mass-weighted diameter for breakup + integer :: iraintailbreak = 0 ! 1 = on + real :: draintail = 8.e-3 ! starting size for rain breakup integer, private :: dmrauto = 0 ! = -1 no limiter on crcnw ! = 0 limit crcnw when qr > 1.2*L (Cohard-Pinty 2002) @@ -540,7 +576,7 @@ MODULE module_mp_nssl_2mom ! = 2 DTD mass-weighted version based on MY code ! = 3 Milbrandt version (from Cohard and Pinty code integer :: dmropt = 0 ! extra option for crcnw - integer :: dmhlopt = 1 ! options for graupel -> conversion + integer :: dmhlopt = 0 ! options for graupel -> hail conversion integer :: irescalerainopt = 3 ! 0 = default option ! 1 = qx(mgs,lc) > qxmin(lc) ! 2 = qx(mgs,lc) > qxmin(lc) .and. wvel(mgs) < 3.0 @@ -557,6 +593,7 @@ MODULE module_mp_nssl_2mom integer :: ivhmltsoak = 1 ! 0=off, 1=on : flag to simulate soaking (graupel/hail) during melting ! when liquid fraction is not predicted + logical, private :: iwetsoak = .true. ! soak and freeze during wet growth or not integer, private :: ioldlimiter = 0 ! test switch for new(=0) or old(=1) size limiter at the end of GS for 3-moment categories integer, private :: isnowfall = 2 ! Option for choosing between snow fall speed parameters ! 1 = original Zrnic et al. (Mansell et al. 2010) @@ -589,9 +626,12 @@ MODULE module_mp_nssl_2mom integer, private :: ibinnum = 2 ! number of bins for melting of smaller ice (for ibinhmlr = 1) integer, private :: iqhacrmlr = 1 ! turn on/off qhacrmlr integer, private :: iqhlacrmlr = 1 ! turn on/off qhlacrmlr + integer, private :: iqhacwshr = 1 ! turn on/off qhacw for T > 0 + integer, private :: iqhlacwshr = 1 ! turn on/off qhlacw for T > 0 real, private :: binmlrmxdia = 40.e-3 ! threshold diameter (graupel/hail) to switch bin-bulk melting to use standard chmlr real, private :: binmlrzrrfac = 1.0 ! factor for reflectivity change ice that sheds while melting real, private :: snowmeltdia = 0 ! If nonzero, sets the size of rain drops from melting snow. + real, private :: alphasmlr0 = 14.0 ! shape parameter for drops formed from melting/shedding snow real, private :: delta_alphamlr = 0.5 ! offset from alphamax at which melting does not further collapse the shape parameter integer :: iqvsopt = 0 ! =0 use old default for tabqvs; =1 use Bolton formulation (Rogers and Yau) @@ -602,6 +642,7 @@ MODULE module_mp_nssl_2mom ! 3 = only add 1.5*cxmin to number concentration (allow max size to apply) ! 4 = add droplets with minimum radius of 20 microns real :: maxsupersat = 1.9 ! maximum supersaturation ratio, above which a saturation adustment is done + real :: maxlowtempss = 1.08 ! Sat. ratio threshold for allowing droplet nucleation at T < tfrh real :: ssmxuf = 4.0 ! supersaturation at which to start using "ultrafine" CCN (if ccnuf > 0.) @@ -732,6 +773,7 @@ MODULE module_mp_nssl_2mom real da1 (lc:lqmx) ! collection coefficients from Seifert 2005 real bb (lc:lqmx) + ! put ipelec here for now.... integer :: ipelec = 0 integer :: isaund = 0 @@ -757,8 +799,8 @@ MODULE module_mp_nssl_2mom double precision, parameter :: dgam = 0.01, dgami = 100. double precision gmoi(0:ngm0) ! ,gmod(0:ngm1,0:ngm2),gmdi(0:ngm1,0:ngm2) - integer, parameter :: nqiacralpha = 240 !480 ! 240 ! 120 ! 15 - integer, parameter :: nqiacrratio = 100 ! 500 !50 ! 25 + integer, parameter :: nqiacralpha = 300 !480 ! 240 ! 120 ! 15 + integer, parameter :: nqiacrratio = 400 ! 500 !50 ! 25 ! real, parameter :: maxratiolu = 25. real, parameter :: maxratiolu = 100. ! 25. real, parameter :: maxalphalu = 15. @@ -775,6 +817,10 @@ MODULE module_mp_nssl_2mom ! real :: ziacrratio(0:nqiacrratio,0:nqiacralpha) ! double precision :: gamxinflu(0:nqiacrratio,0:nqiacralpha,12,2) ! last index for graupel (1) or hail (2) +! for 3-moment collection coefficients + real, save :: dab0lu(ialpstart:nqiacralpha,ialpstart:nqiacralpha,lc:lqmx,lc:lqmx) ! collection coefficients from Seifert 2005 + real, save :: dab1lu(ialpstart:nqiacralpha,ialpstart:nqiacralpha,lc:lqmx,lc:lqmx) ! collection coefficients from Seifert 2005 + integer, parameter :: ngdnmm = 9 real :: mmgraupvt(ngdnmm,3) ! Milbrandt and Morrison (2013) fall speed coefficients for graupel/hail @@ -810,7 +856,6 @@ MODULE module_mp_nssl_2mom ! ! constants ! - real, parameter :: cp608 = 0.608 ! constant used in conversion of T to Tv real, parameter :: ar = 841.99666 ! rain terminal velocity power law coefficient (LFO) real, parameter :: br = 0.8 ! rain terminal velocity power law coefficient (LFO) real, parameter :: aradcw = -0.27544 ! @@ -827,12 +872,14 @@ MODULE module_mp_nssl_2mom ! new values for cs and ds real, parameter :: cs = 12.42 ! snow terminal velocity power law coefficient real, parameter :: ds = 0.42 ! snow terminal velocity power law coefficient + real, parameter :: cp608 = 0.608 ! constant used in conversion of T to Tv + + real, parameter :: gr = 9.8 + real, parameter :: pi = 3.141592653589793 real, parameter :: piinv = 1./pi real, parameter :: pid4 = pi/4.0 - real, parameter :: gr = 9.8 - ! ! max and min mean volumes ! @@ -853,7 +900,7 @@ MODULE module_mp_nssl_2mom ! parameter( xvcmn=4.188e-18 ) ! mks min volume = 3 micron radius real, parameter :: xvcmn=0.523599*(2.*cwradn)**3 ! mks min volume = 2.5 micron radius - real, parameter :: xvcmx=0.523599*(2.*xcradmx)**3 ! mks min volume = 2.5 micron radius + real, parameter :: xvcmx=0.523599*(2.*xcradmx)**3 ! mks max volume = 60 micron radius real, parameter :: cwmasn = 1000.*xvcmn ! minimum mass, defined by radius of 5.0e-6 real, parameter :: cwmasx = 1000.*xvcmx ! maximum mass, defined by radius of 50.0e-6 real, parameter :: cwmasn5 = 1000.*0.523599*(2.*5.0e-6)**3 ! 5.23e-13 @@ -895,25 +942,28 @@ MODULE module_mp_nssl_2mom real, parameter :: cbwbolton = 29.65 ! constants for Bolton formulation real, parameter :: cawbolton = 17.67 - real, parameter :: tfr = 273.15, tfrh = 233.15 + real, parameter :: tfrh = 233.15 + real, parameter :: tfr = 273.15 real, parameter :: cp = 1004.0, rd = 287.04 - real, parameter :: cpi = 1./cp - real, parameter :: cap = rd/cp, poo = 1.0e+05 - real, parameter :: rw = 461.5 ! gas const. for water vapor + real, parameter :: cpl = 4190.0 + real, parameter :: cpigb = 2106.0 + real, parameter :: cpi = 1./cp + real, parameter :: cap = rd/cp + real, parameter :: tfrcbw = tfr - cbw + real, parameter :: tfrcbi = tfr - cbi + real, parameter :: rovcp = rd/cp + real :: rdorv = 0.622 + real, parameter :: poo = 1.0e+05 real, parameter :: advisc0 = 1.832e-05 ! reference dynamic viscosity (SMT; see Beard & Pruppacher 71) real, parameter :: advisc1 = 1.718e-05 ! dynamic viscosity constant used in thermal conductivity calc real, parameter :: tka0 = 2.43e-02 ! reference thermal conductivity - real, parameter :: tfrcbw = tfr - cbw - real, parameter :: tfrcbi = tfr - cbi ! GHB: Needed for eqtset=2 in cm1 ! REAL, PRIVATE :: cv = cp - rd - real, private, parameter :: cv = 717.0 ! specific heat at constant volume - air - REAL, PRIVATE, parameter :: cvv = 1408.5 - REAL, PRIVATE, parameter :: cpl = 4190.0 - REAL, PRIVATE, parameter :: cpigb = 2106.0 + real, private, parameter :: cv = 717.0 ! specific heat at constant volume - air + REAL, PRIVATE, parameter :: cvv = 1408.5 ! GHB real, parameter :: bfnu0 = (rnu + 2.0)/(rnu + 1.0) @@ -942,10 +992,12 @@ MODULE module_mp_nssl_2mom logical, parameter :: do_satadj_for_wrfchem = .true. + integer, parameter :: ac_opt = 0 ! option flag for alternate aerosol (for NUWRF only) + logical, private :: nuaccoinp = .false. ! Note to users: Many of these options are for development and not guaranteed to perform well. ! Some may not be functional depending on the version of the code. -! Some may be useful for ensemble physics diversity. Feel free to contact me if you have questions +! Some may be useful for ensemble physics diversity. Feel free to contact Ted Mansell if you have questions ! in that regard. NAMELIST /nssl_mp_params/ & ndebug, ncdebug,& @@ -955,7 +1007,7 @@ MODULE module_mp_nssl_2mom idbzci, & vtmaxsed, & itfall,iscfall, & - infall, & + infall,irfall,isfall, & rssflg, & sssflg, & hssflg, & @@ -966,12 +1018,15 @@ MODULE module_mp_nssl_2mom icnuclimit, & irenuc, & restoreccn, ccntimeconst, cck, & + decayufccn, ufccntimeconst, & + switchccn, old_cccn, & ciintmx, & itype1, itype2, & - icenucopt, & + icenucopt, in_freeze_rain_first, & naer, & icfn, & ibfc, iacr, icracr, & + icracrthresh, & cwfrz2snowfrac, cwfrz2snowratio, & ibfr, & ibiggopt, & @@ -987,7 +1042,7 @@ MODULE module_mp_nssl_2mom eri_cimin, & eii0hl, eii1hl, & ehs0, ehs1, & - ess0, ess1, & + ess0, ess1, iessopt, & esstem1,esstem2, & ircnw, qminrncw,& ! single-moment only iglcnvi, & @@ -1013,6 +1068,7 @@ MODULE module_mp_nssl_2mom hailfallfac, & icefallopt, & icdx,icdxhl, & + axh,bxh,axf,bxf,axhl,bxhl, & cdhmin, cdhmax, & cdhdnmin, cdhdnmax, & cdhlmin, cdhlmax, & @@ -1047,7 +1103,7 @@ MODULE module_mp_nssl_2mom rescale_low_alphah, & rescale_low_alphahl, & rescale_high_alpha, & - ihlcnh, hldia1,iusedw, dwehwmin, dwmin, dwtempmin, & + ihlcnh, hldia1,iusedw, dwehwmin, dwmin, dwmax, dwtempmin, dg0thresh, & icvhl2h, hldnmn,hdnmn, & hlcnhdia, hlcnhqmin, & isedonly, & @@ -1080,7 +1136,6 @@ MODULE module_mp_nssl_2mom delta_alphamlr, & iqvsopt, & maxsupersat, & - charging_border, & do_accurate_sedimentation, interval_sedi_vt ! ##################################################################### ! ##################################################################### @@ -1106,10 +1161,10 @@ END FUNCTION fqis -! ##################################################################### -! ##################################################################### +! ##################################################################### +! ##################################################################### SUBROUTINE nssl_2mom_init( & & ims,ime, jms,jme, kms,kme, nssl_params, ipctmp, mixphase,ihvol,idoniconlytmp, & & nssl_graupelfallfac, & @@ -1119,7 +1174,15 @@ SUBROUTINE nssl_2mom_init( & & nssl_icdx, & & nssl_icdxhl, & & nssl_icefallfac, & - & nssl_snowfallfac & + & nssl_snowfallfac, & + & nssl_cccn, & + & nssl_ufccn, & + & nssl_alphah, & + & nssl_alphahl, & + & nssl_alphar, & + & nssl_density_on, nssl_hail_on, nssl_ccn_on, nssl_icecrystals_on, ccn_is_ccna, & + & infileunit, & + & myrank, mpiroot & ) implicit none @@ -1130,21 +1193,35 @@ SUBROUTINE nssl_2mom_init( & & nssl_ehw0, & & nssl_ehlw0, & & nssl_icefallfac, & - & nssl_snowfallfac + & nssl_snowfallfac, & + & nssl_cccn, & + & nssl_alphah, & + & nssl_alphahl, & + & nssl_alphar integer, intent(in), optional :: & & nssl_icdx, & - & nssl_icdxhl + & nssl_icdxhl, myrank, mpiroot, & + & nssl_ufccn + logical, intent(in), optional :: nssl_density_on, nssl_hail_on, nssl_ccn_on, nssl_icecrystals_on + integer, intent(inout), optional :: ccn_is_ccna - integer, intent(in) :: ims,ime, jms,jme, kms,kme - real, intent(in), dimension(20) :: nssl_params + integer, intent(in),optional :: infileunit + integer, intent(in), optional :: ims,ime, jms,jme, kms,kme + real, intent(in), dimension(20), optional :: nssl_params - integer, intent(in) :: ipctmp,mixphase,ihvol + + + integer, intent(in) :: ipctmp,mixphase + integer, optional, intent(in) :: ihvol logical, optional, intent(in) :: idoniconlytmp + integer :: igvol_local = 1 logical :: wrote_namelist = .false. logical :: wrf_dm_on_monitor + integer :: hail_on = -1, density_on = -1, icecrystals_on = 1 + integer :: ccn_on = -1 double precision :: arg real :: temq @@ -1152,20 +1229,57 @@ SUBROUTINE nssl_2mom_init( & integer :: i,il,j,l integer :: ltmp integer :: isub - real :: bxh,bxhl + real :: bxh1,bxhl1 real :: alp,ratio double precision :: x,y,y2,y7 logical :: turn_on_ccna, turn_on_cina + integer :: iufccn = 0 integer :: istat + + real :: alpjj, alpii, xnuii, xnujj + integer :: ii, jj turn_on_ccna = .false. turn_on_cina = .false. + +! IF ( present( igvol ) ) THEN +! igvol_local = igvol +! ENDIF + + IF ( present( nssl_hail_on ) ) THEN + IF ( nssl_hail_on ) THEN + hail_on = 1 + ELSE + hail_on = 0 + ENDIF + ENDIF + + IF ( present( nssl_density_on ) ) THEN + IF ( nssl_density_on ) THEN + density_on = 1 + ELSE + density_on = 0 + ENDIF + ENDIF + + IF ( present( nssl_icecrystals_on ) ) THEN + IF ( nssl_icecrystals_on ) THEN + icecrystals_on = 1 + ELSE + icecrystals_on = 0 + ! renucfrac = 1.0 ! why was this set to 1? + ffrzs = 1.0 + ENDIF + ENDIF + + ! ! set some global values from namelist input ! + IF ( present( nssl_params ) ) THEN ccn = Abs( nssl_params(1) ) alphah = nssl_params(2) alphahl = nssl_params(3) @@ -1176,36 +1290,77 @@ SUBROUTINE nssl_2mom_init( & rho_qh = nssl_params(8) rho_qhl = nssl_params(9) rho_qs = nssl_params(10) - + IF ( Nint(nssl_params(13)) == 1 ) THEN + ! hack to switch CCN field to CCNA (activated ccn) +! invertccn = .true. + turn_on_ccna = .true. + irenuc = 7 + ENDIF + ccnuf = Abs( nssl_params(14) ) + IF ( present(nssl_ufccn) ) iufccn = nssl_ufccn + + ENDIF ! ipelec = Nint(nssl_params(11)) ! isaund = Nint(nssl_params(12)) + + IF ( present(nssl_graupelfallfac) ) graupelfallfac = nssl_graupelfallfac IF ( present(nssl_hailfallfac) ) hailfallfac = nssl_hailfallfac - IF ( present(nssl_ehw0) ) ehw0 = nssl_ehw0 - IF ( present(nssl_ehlw0) ) ehlw0 = nssl_ehlw0 + IF ( present(nssl_ehw0) ) THEN + IF ( nssl_ehw0 > 0.0 ) ehw0 = nssl_ehw0 + ENDIF + IF ( present(nssl_ehlw0) ) THEN + IF ( nssl_ehlw0 > 0.0 ) ehlw0 = nssl_ehlw0 + ENDIF IF ( present(nssl_icdx) ) icdx = nssl_icdx IF ( present(nssl_icdxhl) ) icdxhl = nssl_icdxhl IF ( present(nssl_icefallfac) ) icefallfac = nssl_icefallfac IF ( present(nssl_snowfallfac) ) snowfallfac = nssl_snowfallfac + IF ( present(nssl_cccn) ) THEN + IF (nssl_cccn > 1 ) ccn = nssl_cccn + ENDIF + IF ( present(nssl_alphah) ) THEN + IF ( nssl_alphah > -1. ) alphah = nssl_alphah + ENDIF + IF ( present(nssl_alphahl) ) THEN + IF ( nssl_alphahl > -1. ) alphahl = nssl_alphahl + ENDIF + IF ( present(nssl_alphar) ) THEN + IF ( nssl_alphar > -1.0 ) alphar = nssl_alphar + ENDIF - IF ( Nint(nssl_params(13)) == 1 ) THEN - ! hack to switch CCN field to CCNA (activated ccn) -! invertccn = .true. - turn_on_ccna = .true. - irenuc = 7 + ipconc = ipctmp + + IF ( ipconc < 5 ) THEN + ihlcnh = 0 + ENDIF + + IF ( ihlcnh <= 0 ) THEN + IF ( ipconc == 5 ) THEN + ihlcnh = 3 + ELSEIF ( ipconc >= 6 ) THEN + ihlcnh = 3 ENDIF + ENDIF - IF ( .false. ) THEN ! set to true to enable internal namelist read + + IF ( .true. ) THEN ! set to true to enable internal namelist read open(15,file='namelist.input',status='old',form='formatted',action='read') rewind(15) read(15,NML=nssl_mp_params,iostat=istat) close(15) IF ( istat /= 0 ) THEN - write(0,*) 'READ_NAMELIST: PROBLEM WITH NSSL_MP_PARAMS namelist: not found or bad token' +#ifdef WRF_ELEC + IF ( wrf_dm_on_monitor() ) THEN + write(0,*) 'NSSL_2MOM_INIT: PROBLEM WITH NSSL_MP_PARAMS namelist: not found or bad token' + ENDIF +#else + ! write(0,*) 'NSSL_2MOM_INIT: PROBLEM WITH NSSL_MP_PARAMS namelist: not found or bad token' +#endif ENDIF IF ( wrf_dm_on_monitor() .and. .not. wrote_namelist ) THEN open(15,file='namelist.output',status='old',action='readwrite', position='append',form='formatted') @@ -1217,8 +1372,42 @@ SUBROUTINE nssl_2mom_init( & + IF ( iufccn > 0 ) THEN ! make sure to use option that uses UF ccn + irenuc = 7 + IF ( ccnuf <= 0.0 ) decayufccn = .true. ! assume surface emission and need decay + IF ( i_uf_or_ccn > 0 ) THEN + ufbackground = 0.0 + ccntimeconst = ufccntimeconst + ENDIF + ENDIF + + IF ( present( nssl_ccn_on ) ) THEN + IF ( nssl_ccn_on ) THEN + ccn_on = 1 + ELSE + ccn_on = 0 + irenuc = 2 + ENDIF + ENDIF + IF ( irenuc >= 5 ) THEN turn_on_ccna = .true. + IF ( present( nssl_ccn_on ) ) THEN + IF ( .not. nssl_ccn_on ) THEN + write(0,*) 'NSSL_MP Error: Must have nssl_ccn_on=1 for irenuc >= 5!' + STOP + ENDIF + ENDIF + ENDIF + + IF ( present( ccn_is_ccna ) .and. ccn_on == 1 ) THEN + IF ( ccn_is_ccna > 0 ) THEN + turn_on_ccna = .true. + ELSE + IF ( irenuc >= 5 ) THEN + ccn_is_ccna = 1 + ENDIF + ENDIF ENDIF cwccn = ccn @@ -1232,24 +1421,41 @@ SUBROUTINE nssl_2mom_init( & lh = lh + 1 lhl = lhl + 1 ENDIF - IF ( ihvol <= -1 .or. ihvol == 2 ) THEN - IF ( ihvol == -1 .or. ihvol == -2 ) THEN - lhab = lhab - 1 ! turns off hail - lhl = 0 - ! past me thought it would be a good idea to change graupel factors when hail is off.... - ! ehw0 = 0.75 - ! iehw = 2 - ! dfrz = Max( dfrz, 0.5e-3 ) - ENDIF - IF ( ihvol == -2 .or. ihvol == 2 ) THEN ! ice crystals are turned off - ! a value of -3 means to turn off ice crystals but turn on hail - renucfrac = 1.0 - ffrzs = 1.0 - ! idoci = 0 ! try this later + IF ( hail_on == -1 ) THEN ! hail_on is not set + hail_on = 1 + IF ( ihvol <= -1 .or. ihvol == 2 ) THEN + IF ( ihvol == -1 .or. ihvol == -2 ) THEN + lhab = lhab - 1 ! turns off hail + lhl = 0 + hail_on = 0 + ! past me thought it would be a good idea to change graupel factors when hail is off.... + ! ehw0 = 0.75 + ! iehw = 2 + ! dfrz = Max( dfrz, 0.5e-3 ) + ENDIF + IF ( ihvol == -2 .or. ihvol == 2 .or. icecrystals_on == 0 ) THEN ! ice crystals are turned off + ! a value of 2? means to turn off ice crystals but turn on hail + ! renucfrac = 1.0 ! why? + ffrzs = 1.0 + ! idoci = 0 ! try this later + ENDIF + ENDIF + + ELSE ! hail_on is set + IF ( hail_on == 0 ) THEN + lhab = lhab - 1 ! turns off hail + lhl = 0 + ELSE + ! assume default that hail is on ENDIF ENDIF + + IF ( density_on == -1 ) THEN ! density flag not set, so default is to predict it + density_on = 1 + ENDIF + -! write(0,*) 'wrf_init: lhab,lhl = ',lhab,lhl +! write(0,*) 'wrf_init: lhab,lhl,hail_on,density_on = ',lhab,lhl,hail_on,density_on ! IF ( ipelec > 0 ) idonic = .true. @@ -1276,29 +1482,42 @@ SUBROUTINE nssl_2mom_init( & bx(lr) = 0.85 ax(lr) = 1647.81 fx(lr) = 135.477 + IF ( icdx == 6 ) THEN bx(lh) = 0.6 ! Milbrandt and Morrison (2013) for density of 550. ax(lh) = 157.71 - ELSEIF ( icdx > 0 ) THEN +! ELSEIF ( icdx == 1 ) THEN +! bx(lh) = bxh +! ax(lh) = axh + ELSEIF ( icdx > 1 ) THEN bx(lh) = 0.5 ax(lh) = 75.7149 - ELSE - bx(lh) = 0.37 ! 0.6 ! Ferrier 1994 + ELSEIF ( icdx == 0 ) THEN + bx(lh) = 0.37 ! 0.6 ! Ferrier 1994 graupel ax(lh) = 19.3 + ELSE ! icdx < 0 +! ax(lh) = 206.984 ! Ferrier 1994 hail/frozen drops +! bx(lh) = 0.6384 + bx(lh) = bxh + ax(lh) = axh ENDIF + ! bx(lh) = 0.6 IF ( lhl .gt. 1 ) THEN IF ( icdxhl == 6 ) THEN bx(lhl) = 0.593 ! Milbrandt and Morrison (2013) for density of 750. ax(lhl) = 179.36 + ELSEIF (icdxhl == 0 ) THEN + ax(lhl) = 206.984 ! Ferrier 1994 + bx(lhl) = 0.6384 ELSEIF (icdxhl > 0 ) THEN - bx(lhl) = 0.5 - ax(lhl) = 75.7149 + bx(lhl) = 0.5 + ax(lhl) = 75.7149 ELSE - ax(lhl) = 206.984 ! Ferrier 1994 - bx(lhl) = 0.6384 + bx(lhl) = bxhl + ax(lhl) = axhl ENDIF ENDIF @@ -1314,8 +1533,8 @@ SUBROUTINE nssl_2mom_init( & ! Uses incomplete gamma functions ! The terms with bxh or bxhl will be off if the actual bxh or bxhl is different from the base value (icdx=6 option) - bxh = bx(lh) - bxhl = bx(Max(lh,lhl)) + bxh1 = bx(lh) + bxhl1 = bx(Max(lh,lhl)) ! DO j = 0,nqiacralpha DO j = ialpstart,nqiacralpha @@ -1331,9 +1550,9 @@ SUBROUTINE nssl_2mom_init( & ! graupel (.,.,.,1) gamxinflu(i,j,1,1) = x/y gamxinflu(i,j,2,1) = gamxinfdp( 2.0+alp, ratio )/y - gamxinflu(i,j,3,1) = gamxinfdp( 2.5+alp+0.5*bxh, ratio )/y + gamxinflu(i,j,3,1) = gamxinfdp( 2.5+alp+0.5*bxh1, ratio )/y gamxinflu(i,j,5,1) = (gamma_dpr(5.0+alp) - gamxinfdp( 5.0+alp, ratio ))/y - gamxinflu(i,j,6,1) = (gamma_dpr(5.5+alp+0.5*bxh) - gamxinfdp( 5.5+alp+0.5*bxh, ratio ))/y + gamxinflu(i,j,6,1) = (gamma_dpr(5.5+alp+0.5*bxh1) - gamxinfdp( 5.5+alp+0.5*bxh1, ratio ))/y gamxinflu(i,j,9,1) = gamxinfdp( 1.0+alp, ratio )/y gamxinflu(i,j,10,1)= gamxinfdp( 4.0+alp, ratio )/y @@ -1342,9 +1561,9 @@ SUBROUTINE nssl_2mom_init( & ! hail (.,.,.,2) gamxinflu(i,j,1,2) = gamxinflu(i,j,1,1) gamxinflu(i,j,2,2) = gamxinflu(i,j,2,1) - gamxinflu(i,j,3,2) = gamxinfdp( 2.5+alp+0.5*bxhl, ratio )/y + gamxinflu(i,j,3,2) = gamxinfdp( 2.5+alp+0.5*bxhl1, ratio )/y gamxinflu(i,j,5,2) = gamxinflu(i,j,5,1) - gamxinflu(i,j,6,2) = (gamma_dpr(5.5+alp+0.5*bxhl) - gamxinfdp( 5.5+alp+0.5*bxhl, ratio ))/y + gamxinflu(i,j,6,2) = (gamma_dpr(5.5+alp+0.5*bxhl1) - gamxinfdp( 5.5+alp+0.5*bxhl1, ratio ))/y gamxinflu(i,j,9,2) = gamxinflu(i,j,9,1) gamxinflu(i,j,10,2)= gamxinflu(i,j,10,1) @@ -1352,16 +1571,16 @@ SUBROUTINE nssl_2mom_init( & ! gamxinflu(i,j,7,1) = gamxinfdp( alp - 1., ratio )/y gamxinflu(i,j,7,1) = (gamma_dpr(alp - 1.) - gamxinfdp( alp - 1., ratio ))/y ! gamxinflu(i,j,8,1) = gamxinfdp( alp - 0.5 + 0.5*bxh, ratio )/y - gamxinflu(i,j,8,1) = (gamma_dpr(alp - 0.5 + 0.5*bxh) - gamxinfdp( alp - 0.5 + 0.5*bxh, ratio ))/y -! gamxinflu(i,j,8,2) = gamxinfdp( alp - 0.5 + 0.5*bxhl, ratio )/y - gamxinflu(i,j,8,2) = (gamma_dpr(alp - 0.5 + 0.5*bxhl) - gamxinfdp( alp - 0.5 + 0.5*bxhl, ratio ))/y + gamxinflu(i,j,8,1) = (gamma_dpr(alp - 0.5 + 0.5*bxh1) - gamxinfdp( alp - 0.5 + 0.5*bxh1, ratio ))/y +! gamxinflu(i,j,8,2) = gamxinfdp( alp - 0.5 + 0.5*bxhl1, ratio )/y + gamxinflu(i,j,8,2) = (gamma_dpr(alp - 0.5 + 0.5*bxhl1) - gamxinfdp( alp - 0.5 + 0.5*bxhl1, ratio ))/y ELSE ! gamxinflu(i,j,7,1) = gamxinfdp( .1, ratio )/y gamxinflu(i,j,7,1) = (gamma_dpr(0.1) - gamxinfdp( 0.1, ratio ) )/y -! gamxinflu(i,j,8,1) = gamxinfdp( 1.1 - 0.5 + 0.5*bxh, ratio )/y -! gamxinflu(i,j,8,2) = gamxinfdp( 1.1 - 0.5 + 0.5*bxhl, ratio )/y - gamxinflu(i,j,8,1) = (gamma_dpr(1.1 - 0.5 + 0.5*bxh) - gamxinfdp( 1.1 - 0.5 + 0.5*bxh, ratio ) )/y - gamxinflu(i,j,8,2) = (gamma_dpr(1.1 - 0.5 + 0.5*bxhl) - gamxinfdp( 1.1 - 0.5 + 0.5*bxhl, ratio ) )/y +! gamxinflu(i,j,8,1) = gamxinfdp( 1.1 - 0.5 + 0.5*bxh1, ratio )/y +! gamxinflu(i,j,8,2) = gamxinfdp( 1.1 - 0.5 + 0.5*bxhl1, ratio )/y + gamxinflu(i,j,8,1) = (gamma_dpr(1.1 - 0.5 + 0.5*bxh1) - gamxinfdp( 1.1 - 0.5 + 0.5*bxh1, ratio ) )/y + gamxinflu(i,j,8,2) = (gamma_dpr(1.1 - 0.5 + 0.5*bxhl1) - gamxinfdp( 1.1 - 0.5 + 0.5*bxhl1, ratio ) )/y ENDIF gamxinflu(i,j,7,2) = gamxinflu(i,j,7,1) @@ -1395,9 +1614,8 @@ SUBROUTINE nssl_2mom_init( & qiacrratio(0,:) = 1.0 - isub = Min( 0, Max(-1,ihvol) ) ! is -1 or 0 - lccn = 0 + lccnuf = 0 lccna = 0 lnc = 0 lnr = 0 @@ -1419,34 +1637,41 @@ SUBROUTINE nssl_2mom_init( & ! lccn = 9 - ipconc = ipctmp IF ( ipconc == 0 ) THEN - IF ( ihvol >= 0 ) THEN + IF ( hail_on == 1 ) THEN ! turn on graupel density for 1-moment scheme lvh = 9 ltmp = 9 denscale(lvh) = 1 - ELSE ! no hail + ELSE ! no hail, 'LFO' scheme ltmp = lhab lhl = 0 ENDIF ELSEIF ( ipconc == 5 ) THEN - lccn = lhab+1 ! 9 - lnc = lhab+2 ! 10 - lnr = lhab+3 ! 11 - lni = lhab+4 !12 - lns = lhab+5 !13 - lnh = lhab+6 !14 + ltmp = lhab + IF ( iufccn > 0 ) THEN + ltmp = ltmp+1 + lccnuf = ltmp + denscale(lccnuf) = 1 + ENDIF + lccn= ltmp+1 ! 9 + lnc = ltmp+2 ! 10 + lnr = ltmp+3 ! 11 + lni = ltmp+4 !12 + lns = ltmp+5 !13 + lnh = ltmp+6 !14 ltmp = lnh - IF ( ihvol >= 0 ) THEN + IF ( hail_on == 1 ) THEN ltmp = ltmp + 1 lnhl = ltmp ! lhab+7 ! 15 ENDIF + IF ( density_on >= 1 ) THEN ltmp = ltmp + 1 lvh = ltmp ! lhab+8 + isub ! 16 + isub ! isub adjusts to 15 if hail is off ! ltmp = lvh - denscale(lccn:lvh) = 1 - IF ( ihvol >= 1 ) THEN + ENDIF + denscale(lccn:ltmp) = 1 + IF ( density_on == 1 .and. hail_on == 1 ) THEN ltmp = ltmp + 1 lvhl = ltmp ! ltmp = lvhl @@ -1464,24 +1689,31 @@ SUBROUTINE nssl_2mom_init( & ! ltmp = lhlw ENDIF ELSEIF ( ipconc >= 6 ) THEN - write(0,*) 'NSSL microphysics has not been compiled for 3-moment. Sorry.' - STOP - lccn = lhab+1 ! 9 - lnc = lhab+2 ! 10 - lnr = lhab+3 ! 11 - lni = lhab+4 !12 - lns = lhab+5 !13 - lnh = lhab+6 !14 + ltmp = lhab + IF ( iufccn > 0 ) THEN + ltmp = ltmp+1 + lccnuf = ltmp + denscale(lccnuf) = 1 + ENDIF + + lccn= ltmp+1 ! 9 + lnc = ltmp+2 ! 10 + lnr = ltmp+3 ! 11 + lni = ltmp+4 !12 + lns = ltmp+5 !13 + lnh = ltmp+6 !14 ltmp = lnh IF ( lhl > 0 ) THEN ltmp = ltmp + 1 lnhl = ltmp ! lhab+7 ! 15 ENDIF + IF ( density_on == 1 ) THEN ltmp = ltmp + 1 lvh = ltmp ! lhab+8 + isub ! 16 + isub ! isub adjusts to 15 if hail is off + ENDIF ! ltmp = lvh - denscale(lccn:lvh) = 1 - IF ( ihvol >= 1 ) THEN + denscale(lccn:ltmp) = 1 + IF ( density_on == 1 .and. hail_on == 1 ) THEN ltmp = ltmp + 1 lvhl = ltmp ! ltmp = lvhl @@ -1501,19 +1733,14 @@ SUBROUTINE nssl_2mom_init( & lzh = ltmp ltmp = ltmp + 1 lzr = ltmp - ltmp = ltmp + 1 IF ( lhl > 1 ) THEN ltmp = ltmp + 1 lzhl = ltmp ENDIF + ! write(0,*) 'ipcon,lzr = ',ipconc,lzr,lzh,lzhl ENDIF ! ltmp = lvh ! denscale(lccn:lvh) = 1 - IF ( ihvol >= 1 ) THEN - lvhl = ltmp+1 - ltmp = lvhl - denscale(lvhl) = 1 - ENDIF IF ( mixedphase ) THEN ltmp = ltmp + 1 lsw = ltmp @@ -1531,7 +1758,8 @@ SUBROUTINE nssl_2mom_init( & - + ! write(0,*) 'wrf_init: lh,lhl,lzh,lzhl = ',lh,lhl,lzh,lzhl + ! write(0,*) 'wrf_init: ipconc = ',ipconc ! write(0,*) 'wrf_init: irenuc, turn_on_ccna = ',irenuc, turn_on_ccna IF ( turn_on_ccna ) THEN ltmp = ltmp + 1 @@ -1763,9 +1991,16 @@ SUBROUTINE nssl_2mom_init( & IF ( lhl .gt. 1 ) ido(lhl) = idohl IF ( irfall .lt. 0 ) irfall = infall + IF ( isfall .lt. 0 ) isfall = infall IF ( lzr > 0 ) irfall = 0 qccn = ccn/rho00 + qccnuf = ccnuf/rho00 + IF ( old_cccn > 0.0 ) THEN + old_qccn = old_cccn/rho00 + ELSE + old_qccn = qccn + ENDIF ! xvcmx = (4./3.)*pi*xcradmx**3 ! set max rain diameter @@ -1914,6 +2149,33 @@ SUBROUTINE nssl_2mom_init( & ENDDO ENDDO + dab0lu(:,:,:,:) = 0.0 + dab1lu(:,:,:,:) = 0.0 + + IF ( ipconc >= 6 ) THEN + DO il = lc,lhab ! collector + DO j = lc,lhab ! collected + IF ( il .ne. j ) THEN + + DO jj = ialpstart,nqiacralpha + alpjj = float(jj)*dqiacralpha + xnujj = (alpjj - 2.)/3. + DO ii = ialpstart,nqiacralpha + alpii = float(ii)*dqiacralpha + xnuii = (alpii - 2.)/3. + + dab0lu(ii,jj,il,j) = delabk(bb(il), bb(j), xnuii, xnujj, xmu(il), xmu(j), 0) + dab1lu(ii,jj,il,j) = delabk(bb(il), bb(j), xnuii, xnujj, xmu(il), xmu(j), 1) + + ENDDO + ENDDO +! write(0,*) 'il, j, dab0, dab1 = ',il, j, dab0(il,j), dab1(il,j) + ENDIF + ENDDO + ENDDO + + ENDIF + gf4br = gamma_sp(4.0+br) gf4ds = gamma_sp(4.0+ds) gf4p5 = gamma_sp(4.0+0.5) @@ -1960,24 +2222,31 @@ END SUBROUTINE nssl_2mom_init ! ##################################################################### SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw, chl, & - cn, vhw, vhl, cna, cni, f_cn, f_cna, f_cina, & - zrw, zhw, zhl, & + cn, vhw, vhl, cna, cni, f_cn, f_cna, f_cina, & + f_qc, f_qr, f_qi, f_qs, f_qh, f_qhl, & + cnuf, f_cnuf, & + zrw, zhw, zhl, f_zrw, f_zhw, f_zhl, f_vhw, f_vhl, & qsw, qhw, qhlw, & tt, th, pii, p, w, dn, dz, dtp, itimestep, & + is_theta_or_temp, & + ntmul, ntcnt, lastloop, & RAINNC,RAINNCV, & dx, dy, & axtra, & SNOWNC, SNOWNCV, GRPLNC, GRPLNCV, & SR,HAILNC, HAILNCV, & + hail_maxk1, hail_max2d, nwp_diagnostics, & tkediss, & - re_cloud, re_ice, re_snow, & - has_reqc, has_reqi, has_reqs, & + re_cloud, re_ice, re_snow, re_rain, & + re_graup, re_hail, & + has_reqc, has_reqi, has_reqs, has_reqr, & + has_reqg, has_reqh, & rainncw2, rainnci2, & dbz, vzf,compdbz, & rscghis_2d,rscghis_2dp,rscghis_2dn, & scr,scw,sci,scs,sch,schl,sctot, & elec_physics, & - induc,elec,scion,sciona, & + induc,elecz,scion,sciona, & noninduc,noninducp,noninducn, & pcc2, pre2, depsubr, & mnucf2, melr2, ctr2, & @@ -2004,6 +2273,8 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw + + implicit none @@ -2021,7 +2292,9 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw zrw, zhw, zhl, & qsw, qhw, qhlw, & qi,qhl,ccw,crw,cci,csw,chw,chl,vhw,vhl - real, dimension(ims:ime, kms:kme, jms:jme), optional, intent(inout):: dbz, vzf, cn, cna, cni + integer, optional, intent(in) :: is_theta_or_temp + logical, optional, intent(in) :: f_zrw, f_zhw, f_zhl, f_vhw, f_vhl ! not used yet + real, dimension(ims:ime, kms:kme, jms:jme), optional, intent(inout):: dbz, vzf, cn, cna, cni, cnuf real, dimension(ims:ime, jms:jme), optional, intent(inout):: compdbz real, dimension(ims:ime, jms:jme), optional, intent(inout):: rscghis_2d, & ! 2D accumulation arrays for vertically-integrated charging rate rscghis_2dp, & ! 2D accumulation arrays for vertically-integrated charging rate (positive only) @@ -2032,8 +2305,8 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw scr,scw,sci,scs,sch,schl,sciona,sctot ! space charge real, dimension(ims:ime, kms:kme, jms:jme), optional, intent(inout):: & induc,noninduc,noninducp,noninducn ! charging rates: inductive, noninductive (all, positive, negative to graupel) - real, dimension(ims:ime, kms:kme, jms:jme), optional, intent(in) :: elec ! elecsave = Ez - real, dimension(ims:ime, kms:kme, jms:jme,2),optional, intent(inout) :: scion + real, dimension(ims:ime, kms:kme, jms:jme), optional, intent(in) :: elecz ! elecsave = Ez + real, dimension(ims:ime, kms:kme, jms:jme,2),optional, intent(inout) :: scion real, dimension(ims:ime, kms:kme, jms:jme), intent(in):: p,w,dz,dn real, dimension(ims:ime, kms:kme, jms:jme), intent(in):: pii @@ -2054,29 +2327,44 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw real, dimension(ims:ime, kms:kme, jms:jme), optional, intent(inout) :: axtra ! WRF variables - real, dimension(ims:ime, jms:jme), intent(inout):: & + real, dimension(ims:ime, jms:jme) :: & RAINNC,RAINNCV ! accumulated precip (NC) and rate (NCV) real, dimension(ims:ime, jms:jme), optional, intent(inout):: & SNOWNC,SNOWNCV,GRPLNC,GRPLNCV,SR ! accumulated precip (NC) and rate (NCV) real, dimension(ims:ime, jms:jme), optional, intent(inout):: & HAILNC,HAILNCV ! accumulated precip (NC) and rate (NCV) - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), optional, INTENT(INOUT):: re_cloud, re_ice, re_snow + real, dimension(ims:ime, jms:jme), optional, intent(inout) :: hail_maxk1, hail_max2d + integer, optional, intent(in) :: nwp_diagnostics +! for cm1, set nproctot=44 (or as needed) to get domain total rates + integer, parameter :: nproc = 1 + double precision :: proctot(nproc),proctotmpi(nproc) + REAL, DIMENSION(ims:ime, kms:kme, jms:jme), optional, INTENT(INOUT):: re_cloud, re_ice, re_snow, & + re_rain, re_graup, re_hail REAL, DIMENSION(ims:ime, kms:kme, jms:jme), optional, INTENT(IN):: tkediss - INTEGER, INTENT(IN), optional :: has_reqc, has_reqi, has_reqs + INTEGER, INTENT(IN), optional :: has_reqc, has_reqi, has_reqs, has_reqr, has_reqg, has_reqh real, dimension(ims:ime, jms:jme), intent(out), optional :: & rainncw2, rainnci2 ! liquid rain, ice, accumulation rates real, optional, intent(in) :: dx,dy real, intent(in):: dtp integer, intent(in):: itimestep !, ccntype - logical, optional, intent(in) :: diagflag, f_cna, f_cn, f_cina + integer, intent(in), optional :: ntmul, ntcnt + logical, optional, intent(in) :: lastloop + logical, optional, intent(in) :: diagflag, f_cna, f_cn, f_cina, f_cnuf + logical, optional, intent(in) :: f_qc, f_qr, f_qi, f_qs, f_qh, f_qhl integer, optional, intent(in) :: ipelectmp, ke_diag + LOGICAL, INTENT(IN), OPTIONAL :: nssl_progn ! flags for wrf-chem ! REAL, DIMENSION(ims:ime, kms:kme, jms:jme), optional,INTENT(INOUT):: qndrop LOGICAL :: flag_qndrop ! wrf-chem LOGICAL :: flag_qnifa , flag_qnwfa + logical :: flag_cnuf = .false. + logical :: flag_ccn = .false. + logical :: flag_qi = .true. + logical :: has_reqr_local = .false., has_reqg_local = .false., has_reqh_local = .false. logical :: flag + logical :: nwp_diagflag = .false. real :: cinchange, t7max,testmax,wmax ! 20130903 acd_ck_washout start @@ -2101,11 +2389,14 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw real, dimension(its:ite, kts:kte) :: rainprod2d, evapprod2d,tke2d real, dimension(its:ite, 1, kts:kte, na) :: an, ancuten real, dimension(its:ite, 1, kts:kte, nxtra) :: axtra2d + real, dimension(its:ite, 1, kts:kte, 3) :: alpha2d real, dimension(its:ite, 1, kts:kte) :: t0,t1,t2,t3,t4,t5,t6,t7,t8,t9 real, dimension(its:ite, 1, kts:kte) :: dn1,t00,t77,ssat,pn,wn,dz2d,dz2dinv,dbz2d,vzf2d real, dimension(its:ite, 1, na) :: xfall + real, dimension(its:ite, 1) :: hailmax1d,hailmaxk1 + real, dimension(kts:kte, nproc) :: thproclocal integer, parameter :: nor = 0, ng = 0 - integer :: nx,ny,nz + integer :: nx,ny,nz,ngs integer ix,jy,kz,i,j,k,il,n integer :: infdo real :: ssival, ssifac, t8s, t9s, qvapor @@ -2116,6 +2407,7 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw real :: dbzmx,refl integer :: vzflag0 = 0 logical :: makediag + real :: dx1,dy1 real, parameter :: cnin20 = 1.0e3 real, parameter :: cnin10 = 5.0e1 real, parameter :: cnin1a = 4.5 @@ -2129,7 +2421,7 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw double precision :: grmass1,grmass2 double precision :: hlmass1,hlmass2 double precision :: wvol5,wvol10 - real :: tmp,dv,dv1 + real :: tmp,dv,dv1,tmpchg real :: rdt double precision :: dt1,dt2 @@ -2144,15 +2436,11 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw real :: ycent, y, emissrate, emissrate0, emissrate1, z, fac, factot real :: fach(kts:kte) - -#ifdef MPI - -#if defined(MPI) - integer, parameter :: ntot = 50 - double precision mpitotindp(ntot), mpitotoutdp(ntot) - INTEGER :: mpi_error_code = 1 -#endif -#endif + + logical, parameter :: debugdriver = .false. + + integer :: loopcnt, loopmax, outerloopcnt + logical :: lastlooptmp ! ------------------------------------------------------------------- @@ -2160,18 +2448,58 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw rdt = 1.0/dtp -! write(0,*) 'N2M: entering routine' + IF ( debugdriver ) write(0,*) 'N2M: entering routine' flag_qndrop = .false. flag_qnifa = .false. flag_qnwfa = .false. + flag_cnuf = .false. + flag_ccn = .false. + nwp_diagflag = .false. IF ( PRESENT ( nssl_progn ) ) flag_qndrop = nssl_progn + IF ( present ( f_cnuf ) ) flag_cnuf = f_cnuf + IF ( present ( nwp_diagnostics ) ) nwp_diagflag = ( nwp_diagnostics > 0 ) + IF ( present ( f_cn ) .and. present( cn ) ) THEN + flag_ccn = f_cn + ELSEIF ( present( cn ) ) THEN + flag_ccn = .true. + ENDIF + + IF ( present( f_qi ) ) THEN + flag_qi = f_qi + ELSE + IF ( ffrzs < 1.0 ) THEN + flag_qi = .true. + ELSE + flag_qi = .false. + ENDIF + ENDIF + IF ( .not. flag_qi .and. ffrzs < 1.0 ) ffrzs = 1.0 + + IF ( PRESENT ( has_reqr ) ) has_reqr_local = has_reqr > 0 + IF ( PRESENT ( has_reqg ) ) has_reqg_local = has_reqg > 0 + IF ( PRESENT ( has_reqh ) ) has_reqh_local = has_reqh > 0 - ! --- + loopmax = 1 + outerloopcnt = 1 + lastlooptmp = .true. + IF ( present( ntmul ) .and. present( ntcnt ) .and. present( lastloop ) ) THEN + loopmax = ntmul + outerloopcnt = ntcnt + lastlooptmp = lastloop + ENDIF + + + has_wetscav = .false. + IF ( wrfchem_flag > 0 ) THEN + IF ( PRESENT( wetscav_on ) ) THEN + has_wetscav = wetscav_on + ENDIF + ENDIF IF ( present( f_cna ) ) THEN f_cnatmp = f_cna @@ -2202,25 +2530,35 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ! ENDDO ! ENDIF + IF ( present( dx ) .and. present( dy ) ) THEN + dx1 = dx + dy1 = dy + ELSE + dx1 = 1.0 + dy1 = 1.0 + ENDIF + makediag = .true. IF ( present( diagflag ) ) THEN makediag = diagflag .or. itimestep == 1 ENDIF -! write(0,*) 'N2M: makediag = ',makediag + IF ( debugdriver ) write(0,*) 'N2M: makediag = ',makediag nx = ite-its+1 ny = 1 ! set up as 2D slabs nz = kte-kts+1 + ngs = 64 - IF ( .not. present( cn ) ) THEN + IF ( .not. flag_ccn ) THEN renucfrac = 1.0 ENDIF + ! set up CCN array and some other static local values - IF ( itimestep == 1 .and. .not. invertccn .and. present( cn ) ) THEN + IF ( itimestep == 1 .and. .not. invertccn .and. flag_ccn ) THEN ! this is not needed for WRF 3.8 and later because it is done in physics_init, ! but kept for backwards compatibility with earlier versions IF ( lccna > 1 .and. .not. ( present( cna ) .and. f_cnatmp ) ) THEN @@ -2242,9 +2580,21 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ENDDO ENDDO ENDIF + + IF ( lccnuf > 1 .and. flag_cnuf .and. ccnuf > 1.0 ) THEN +! write(0,*) 'set cnuf1' + DO jy = jts,jte + DO kz = kts,kte + DO ix = its,ite + cnuf(ix,kz,jy) = qccnuf + ENDDO + ENDDO + ENDDO + ENDIF + ENDIF - IF ( itimestep == 1 .and. invertccn .and. present( cn ) ) THEN + IF ( itimestep == 1 .and. invertccn .and. flag_ccn ) THEN ! this is not needed for WRF 3.8 and later because it is done in physics_init, ! but kept for backwards compatibility with earlier versions DO jy = jts,jte @@ -2256,7 +2606,7 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ENDDO ENDIF - IF ( invertccn .and. present( cn ) ) THEN ! hack for WRF to convert activated ccn to unactivated, then do not have to + IF ( invertccn .and. flag_ccn ) THEN ! hack for WRF to convert activated ccn to unactivated, then do not have to ! worry about initial and boundary conditions - they are zero DO jy = jts,jte DO kz = kts,kte @@ -2265,7 +2615,20 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ENDDO ENDDO ENDDO + + IF ( lccnuf > 1 .and. flag_cnuf .and. ccnuf > 1.0 ) THEN +! write(0,*) 'set cnuf (invertccn)' + DO jy = jts,jte + DO kz = kts,kte + DO ix = its,ite + cnuf(ix,kz,jy) = qccnuf - cnuf(ix,kz,jy) + ENDDO + ENDDO + ENDDO ENDIF + + ENDIF + ! ENDIF ! itimestep == 1 @@ -2316,32 +2679,36 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw -! write(0,*) 'N2M: jy loop 1, lhl,na = ',lhl,na,present(qhl) + IF ( debugdriver ) write(0,*) 'N2M: jy loop 1, lhl,na = ',lhl,na,present(qhl) ancuten(its:ite,1,kts:kte,:) = 0.0 + thproclocal(:,:) = 0.0 + DO jy = jts,jye - xfall(:,:,:) = 0.0 - ! write(0,*) 'N2M: load an, jy,lccn = ',jy,lccn,qccn IF ( present( pcc2 ) .and. makediag ) THEN axtra2d(its:ite,1,kts:kte,:) = 0.0 ENDIF + IF ( nwp_diagflag ) THEN + alpha2d(its:ite,1,kts:kte,1) = alphar + alpha2d(its:ite,1,kts:kte,2) = alphah + alpha2d(its:ite,1,kts:kte,3) = alphahl + ENDIF + + ! copy from 3D array to 2D slab DO kz = kts,kte DO ix = its,ite - an(ix,1,kz,lt) = th(ix,kz,jy) - - an(ix,1,kz,lv) = qv(ix,kz,jy) an(ix,1,kz,lc) = qc(ix,kz,jy) an(ix,1,kz,lr) = qr(ix,kz,jy) - IF ( present( qi ) ) THEN + IF ( flag_qi ) THEN an(ix,1,kz,li) = qi(ix,kz,jy) ELSE an(ix,1,kz,li) = 0.0 @@ -2352,13 +2719,16 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw IF ( lccn > 1 ) THEN IF ( is_aerosol_aware .and. flag_qnwfa ) THEN ! - ELSEIF ( present( cn ) ) THEN + ELSEIF ( flag_ccn ) THEN IF ( lccna > 1 .and. .not. ( present( cna ) .and. f_cnatmp ) ) THEN an(ix,1,kz,lccna) = cn(ix,kz,jy) an(ix,1,kz,lccn) = qccn ! cn(ix,kz,jy) ELSE an(ix,1,kz,lccn) = cn(ix,kz,jy) ENDIF + IF ( i_uf_or_ccn > 0 .and. lccnuf > 1 ) THEN ! UF ccn are extra regular ccn + an(ix,1,kz,lccn) = an(ix,1,kz,lccn) + cnuf(ix,kz,jy) + ENDIF ELSE IF ( lccna == 0 .and. ( .not. f_cnatmp ) ) THEN an(ix,1,kz,lccn) = qccn - ccw(ix,kz,jy) @@ -2369,6 +2739,14 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ENDIF ENDIF + IF ( lccnuf > 0 .and. flag_cnuf ) THEN + IF ( i_uf_or_ccn == 0 ) THEN ! UF are UF + an(ix,1,kz,lccnuf) = Max(0.0, cnuf(ix,kz,jy) ) + ELSE ! UF were added to lccn + an(ix,1,kz,lccnuf) = 0.0 + ENDIF + ENDIF + IF ( lccna > 1 ) THEN IF ( present( cna ) .and. f_cnatmp ) THEN an(ix,1,kz,lccna) = cna(ix,kz,jy) @@ -2399,12 +2777,42 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw IF ( lvh > 0 ) an(ix,1,kz,lvh) = vhw(ix,kz,jy) IF ( lvhl > 0 .and. present( vhl ) ) an(ix,1,kz,lvhl) = vhl(ix,kz,jy) + IF ( ipconc >= 6 ) THEN + IF ( lzr > 0 ) an(ix,1,kz,lzr) = zrw(ix,kz,jy)*zscale + IF ( lzh > 0 ) an(ix,1,kz,lzh) = zhw(ix,kz,jy)*zscale + IF ( lzhl > 0 ) an(ix,1,kz,lzhl) = zhl(ix,kz,jy)*zscale + ENDIF + ENDDO + ENDDO + + DO kz = kts,kte + DO ix = its,ite t0(ix,1,kz) = th(ix,kz,jy)*pii(ix,kz,jy) ! temperature (Kelvin) + t00(ix,1,kz) = 380.0/p(ix,kz,jy) + t77(ix,1,kz) = pii(ix,kz,jy) + dbz2d(ix,1,kz) = 0.0 + vzf2d(ix,1,kz) = 0.0 + ENDDO + ENDDO + + DO ix = its,ite + RAINNCV(ix,jy) = 0.0 + IF ( present( GRPLNCV ) ) GRPLNCV(ix,jy) = 0.0 + IF ( present( HAILNCV ) ) HAILNCV(ix,jy) = 0.0 + IF ( present( SNOWNCV ) ) SNOWNCV(ix,jy) = 0.0 + ENDDO + + DO loopcnt = 1,loopmax + + DO kz = kts,kte + DO ix = its,ite + + t1(ix,1,kz) = 0.0 t2(ix,1,kz) = 0.0 t3(ix,1,kz) = 0.0 @@ -2414,14 +2822,10 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw t7(ix,1,kz) = 0.0 t8(ix,1,kz) = 0.0 t9(ix,1,kz) = 0.0 - t00(ix,1,kz) = 380.0/p(ix,kz,jy) - t77(ix,1,kz) = pii(ix,kz,jy) - dbz2d(ix,1,kz) = 0.0 - vzf2d(ix,1,kz) = 0.0 - dn1(ix,1,kz) = dn(ix,kz,jy) pn(ix,1,kz) = p(ix,kz,jy) wn(ix,1,kz) = w(ix,kz,jy) + dn1(ix,1,kz) = dn(ix,kz,jy) ! wmax = Max(wmax,wn(ix,1,kz)) dz2d(ix,1,kz) = dz(ix,kz,jy) dz2dinv(ix,1,kz) = 1./dz(ix,kz,jy) @@ -2439,6 +2843,7 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ! ssival = Min(t8s,max(an(ix,1,kz,lv),0.0))/t9s ! qv/qvi + if ( ssival .gt. 1.0 ) then ! IF ( icenucopt == 1 ) THEN @@ -2491,19 +2896,20 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ELSEIF ( icenucopt == 4 ) THEN ! DeMott 2010 - IF ( t0(ix,jy,kz) < 268.16 .and. t0(ix,jy,kz) > 223.15 .and. ssival > 1.001 ) THEN ! + IF ( t0(ix,1,kz) < 268.16 .and. t0(ix,1,kz) > 223.15 .and. ssival > 1.001 ) THEN ! ! a = 0.0000594, b = 3.33, c = 0.0264, d = 0.0033, ! nint = a*(-Tc)**b * naer**(c*(-Tc) + d) ! nint has units of per (standard) liter, so mult by 1.e3 and scale by dn/rho00 ! naer needs units of cm**-3, so mult by 1.e-6 - ! dp1 = 1.e3*0.0000594*(273.16 - t0(ix,jy,kz))**3.33 * (1.e-6*cin*dn(ix,jy,kz))**(0.0264*(273.16 - t0(ix,jy,kz)) + 0.0033) - dp1 = 1.e3*dn(ix,jy,kz)/rho00*0.0000594*(273.16 - t0(ix,jy,kz))**3.33 * (1.e-6*naer)**(0.0264*(273.16 - t0(ix,jy,kz)) + 0.0033) - t7(ix,jy,kz) = Min(dp1, 1.0d30) + ! dp1 = 1.e3*0.0000594*(273.16 - t0(ix,1,kz))**3.33 * (1.e-6*cin*dn(ix,1,kz))**(0.0264*(273.16 - t0(ix,1,kz)) + 0.0033) + tmp = 1.e-6*naer + dp1 = 1.e3*dn1(ix,1,kz)/rho00*0.0000594*(273.16 - t0(ix,1,kz))**3.33 * tmp**(0.0264*(273.16 - t0(ix,1,kz)) + 0.0033) + t7(ix,1,kz) = Min(dp1, 1.0d30) ELSE - t7(ix,jy,kz) = 0.0 + ! t7(ix,1,kz) = 0.0 ENDIF ENDIF ! icenucopt @@ -2516,48 +2922,48 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ENDDO ! ix ENDDO ! kz - has_wetscav = .false. - IF ( wrfchem_flag > 0 ) THEN - IF ( PRESENT( wetscav_on ) ) THEN - has_wetscav = wetscav_on - IF ( has_wetscav ) THEN - IF ( PRESENT( rainprod ) ) rainprod2d(its:ite,kts:kte) = 0 - IF ( PRESENT( evapprod ) ) evapprod2d(its:ite,kts:kte) = 0 - ENDIF - ENDIF - ENDIF + IF ( wrfchem_flag > 0 ) THEN + IF ( has_wetscav ) THEN + IF ( PRESENT( rainprod ) ) rainprod2d(its:ite,kts:kte) = 0 + IF ( PRESENT( evapprod ) ) evapprod2d(its:ite,kts:kte) = 0 + ENDIF + ENDIF ! transform from number mixing ratios to number conc. + IF ( loopcnt == 1 ) THEN DO il = lnb,na IF ( denscale(il) == 1 ) THEN DO kz = kts,kte DO ix = its,ite - an(ix,1,kz,il) = an(ix,1,kz,il)*dn(ix,kz,jy) + an(ix,1,kz,il) = an(ix,1,kz,il)*dn1(ix,1,kz) ! dn(ix,kz,jy) ENDDO ENDDO ENDIF ENDDO ! il + ENDIF + ! sedimentation xfall(:,:,:) = 0.0 - IF ( .true. ) THEN + +! IF ( .true. ) THEN ! #ifndef CM1 ! for real cases when hydrometeor mixing ratios have been initialized without concentrations - IF ( itimestep == 1 .and. ipconc > 0 ) THEN + IF ( itimestep == 1 .and. ipconc > 0 .and. loopcnt == 1 ) THEN call calcnfromq(nx,ny,nz,an,na,nor,nor,dn1) ENDIF ! #endif IF ( present(cu_used) .and. & ( present( qrcuten ) .or. present( qscuten ) .or. & - present( qicuten ) .or. present( qccuten ) ) ) THEN + present( qicuten ) .or. present( qccuten ) ) ) THEN !{ - IF ( cu_used == 1 ) THEN + IF ( cu_used == 1 ) THEN !{ DO kz = kts,kte DO ix = its,ite @@ -2571,10 +2977,22 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw call calcnfromcuten(nx,ny,nz,ancuten,an,na,nor,nor,dn1) - - ENDIF - - ENDIF + DO kz = kts,kte + DO ix = its,ite + + + IF ( ipconc >= 6 ) THEN +! IF ( lzr > 0 ) an(ix,1,kz,lzr) = an(ix,1,kz,lzr) + ancuten(ix,1,kz,lzr) + ENDIF + + ENDDO + ENDDO + + ENDIF !} + + ENDIF !} + + call sediment1d(dtp,nx,ny,nz,an,na,nor,nor,xfall,dn1,dz2d,dz2dinv, & @@ -2584,14 +3002,16 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ! copy xfall to appropriate places... -! write(0,*) 'N2M: end sediment, jy = ',jy + IF ( debugdriver ) write(0,*) 'N2M: end sediment, jy = ',jy DO ix = its,ite IF ( lhl > 1 ) THEN - RAINNCV(ix,jy) = dtp*dn1(ix,1,1)*(xfall(ix,1,lr) + xfall(ix,1,ls)*1000./xdn0(lr) + & + RAINNCV(ix,jy) = RAINNCV(ix,jy) + & + dtp*dn1(ix,1,1)*(xfall(ix,1,lr) + xfall(ix,1,ls)*1000./xdn0(lr) + & & xfall(ix,1,lh)*1000./xdn0(lr) + xfall(ix,1,lhl)*1000./xdn0(lr) ) ELSE - RAINNCV(ix,jy) = dtp*dn1(ix,1,1)*(xfall(ix,1,lr) + xfall(ix,1,ls)*1000./xdn0(lr) + & + RAINNCV(ix,jy) = RAINNCV(ix,jy) + & + dtp*dn1(ix,1,1)*(xfall(ix,1,lr) + xfall(ix,1,ls)*1000./xdn0(lr) + & & xfall(ix,1,lh)*1000./xdn0(lr) ) ENDIF IF ( present ( rainncw2 ) ) THEN ! rain only @@ -2606,11 +3026,19 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw & xfall(ix,1,lh)*1000./xdn0(lr) ) ENDIF ENDIF - IF ( present( SNOWNCV ) ) SNOWNCV(ix,jy) = dtp*dn1(ix,1,1)*xfall(ix,1,ls)*1000./xdn0(lr) - IF ( present( GRPLNCV ) ) GRPLNCV(ix,jy) = dtp*dn1(ix,1,1)*xfall(ix,1,lh)*1000./xdn0(lr) - RAINNC(ix,jy) = RAINNC(ix,jy) + RAINNCV(ix,jy) + IF ( present( SNOWNCV ) ) SNOWNCV(ix,jy) = SNOWNCV(ix,jy) + dtp*dn1(ix,1,1)*xfall(ix,1,ls)*1000./xdn0(lr) + IF ( present( GRPLNCV ) ) THEN + IF ( lhl > 1 .and. .not. present( HAILNC) ) THEN ! if no separate hail accum, then add to graupel + GRPLNCV(ix,jy) = GRPLNCV(ix,jy) + dtp*dn1(ix,1,1)*(xfall(ix,1,lh) + xfall(ix,1,lhl)) *1000./xdn0(lr) + ELSE + GRPLNCV(ix,jy) = GRPLNCV(ix,jy) + dtp*dn1(ix,1,1)*xfall(ix,1,lh)*1000./xdn0(lr) + ENDIF + ENDIF + IF ( loopcnt == loopmax ) RAINNC(ix,jy) = RAINNC(ix,jy) + RAINNCV(ix,jy) - IF ( present (SNOWNC) .and. present (SNOWNCV) ) SNOWNC(ix,jy) = SNOWNC(ix,jy) + SNOWNCV(ix,jy) + IF ( present (SNOWNC) .and. present (SNOWNCV) .and. loopcnt == loopmax ) THEN + SNOWNC(ix,jy) = SNOWNC(ix,jy) + SNOWNCV(ix,jy) + ENDIF IF ( lhl > 1 ) THEN !#ifdef CM1 ! IF ( .true. ) THEN @@ -2618,13 +3046,15 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw IF ( present( HAILNC ) ) THEN !#endif HAILNCV(ix,jy) = dtp*dn1(ix,1,1)*xfall(ix,1,lhl)*1000./xdn0(lr) - HAILNC(ix,jy) = HAILNC(ix,jy) + HAILNCV(ix,jy) - ELSEIF ( present( GRPLNCV ) ) THEN - GRPLNCV(ix,jy) = dtp*dn1(ix,1,1)*xfall(ix,1,lhl)*1000./xdn0(lr) + IF ( loopcnt == loopmax ) HAILNC(ix,jy) = HAILNC(ix,jy) + HAILNCV(ix,jy) +! ELSEIF ( present( GRPLNCV ) ) THEN ! if no separate hail accum, then add to graupel +! GRPLNCV(ix,jy) = GRPLNCV(ix,jy) + dtp*dn1(ix,1,1)*xfall(ix,1,lhl)*1000./xdn0(lr) ENDIF ENDIF - IF ( present( GRPLNCV ) ) GRPLNC(ix,jy) = GRPLNC(ix,jy) + GRPLNCV(ix,jy) - IF ( present( SR ) .and. present (SNOWNCV) .and. present(GRPLNCV) ) THEN + IF ( present( GRPLNCV ) .and. loopcnt == loopmax ) THEN + GRPLNC(ix,jy) = GRPLNC(ix,jy) + GRPLNCV(ix,jy) + ENDIF + IF ( present( SR ) .and. present (SNOWNCV) .and. present(GRPLNCV) .and. loopcnt == loopmax ) THEN IF ( present( HAILNC ) ) THEN SR(ix,jy) = (SNOWNCV(ix,jy)+HAILNCV(ix,jy)+GRPLNCV(ix,jy))/(RAINNCV(ix,jy)+1.e-12) ELSE @@ -2633,12 +3063,12 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ENDIF ENDDO - ENDIF ! .false. +! ENDIF ! .false. IF ( isedonly /= 1 ) THEN ! call nssl_2mom_gs: main gather-scatter routine to calculate microphysics -! write(0,*) 'N2M: gs, jy = ',jy + IF ( debugdriver ) write(0,*) 'N2M: gs, jy = ',jy ! IF ( isedonly /= 2 ) THEN @@ -2655,8 +3085,9 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ! & ln,ipc,lvol,lz,lliq, & & cdx, & & xdn0,dbz2d,tke2d, & + & thproclocal,nproc,dx1,dy1,ngs, & & timevtcalc,axtra2d, makediag & - & ,has_wetscav, rainprod2d, evapprod2d & + & ,has_wetscav, rainprod2d, evapprod2d, alpha2d & & ,elec2,its,ids,ide,jds,jde & & ) @@ -2674,28 +3105,32 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw & ,dz2d & & ,t0,t9 & & ,an,dn1,t77 & - & ,pn,wn & + & ,pn,wn & + & ,ngs & & ,axtra2d, makediag & & ,ssat,t00,t77,flag_qndrop) + ENDIF + + + ENDDO ! loopcnt=1,loopmax IF ( present( pcc2 ) .and. makediag ) THEN DO kz = kts,kte DO ix = its,ite ! example of using the 'axtra2d' array to get rates out of the microphysics routine for output. ! Search for 'axtra' to find example code below ! pcc2(ix,kz,jy) = axtra2d(ix,1,kz,1) - ENDDO ENDDO ENDIF ! compute diagnostic S-band reflectivity if needed - IF ( present( dbz ) .and. makediag ) THEN + IF ( present( dbz ) .and. makediag .and. lastlooptmp ) THEN ! calc dbz IF ( .true. ) THEN @@ -2733,7 +3168,8 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ! Following Greg Thompson, calculation for effective radii. Used by RRTMG LW/SW schemes if enabled in module_physics_init.F IF ( present( has_reqc ).and. present( has_reqi ) .and. present( has_reqs ) .and. & - present( re_cloud ).and. present( re_ice ) .and. present( re_snow ) ) THEN + present( re_cloud ).and. present( re_ice ) .and. present( re_snow ) .and. & + lastlooptmp) THEN IF ( has_reqc.ne.0 .or. has_reqi.ne.0 .or. has_reqs.ne.0) THEN DO kz = kts,kte DO ix = its,ite @@ -2743,14 +3179,17 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw t1(ix,1,kz) = 2.51E-6 t2(ix,1,kz) = 10.01E-6 t3(ix,1,kz) = 25.E-6 + t4(ix,1,kz) = 50.e-6 ENDDO ENDDO + call calc_eff_radius & & (nx,ny,nz,na,jy & & ,nor,nor & - & ,t1,t2,t3 & - & ,an,dn1 ) + & ,t1=t1,t2=t2,t3=t3,t4=t4,t5=t5,t6=t6 & + & ,f_t4=has_reqr_local,f_t5=has_reqg_local, f_t6=has_reqh_local & + & ,an=an,dn=dn1 ) DO kz = kts,kte DO ix = its,ite @@ -2761,19 +3200,63 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw IF ( .not. present(qi) ) re_ice(ix,kz,jy) = MAX(10.E-6, MIN(t3(ix,1,kz), 125.E-6)) ENDDO ENDDO + + IF ( present(has_reqr) .and. present( re_rain ) ) THEN + IF ( has_reqr /= 0 ) THEN + DO kz = kts,kte + DO ix = its,ite + re_rain(ix,kz,jy) = MAX(50.E-6, MIN(t4(ix,1,kz), 2999.E-6)) + ENDDO + ENDDO + ENDIF + ENDIF + + IF ( present(has_reqg) .and. present( re_graup ) ) THEN + IF ( has_reqg /= 0 ) THEN + DO kz = kts,kte + DO ix = its,ite + re_graup(ix,kz,jy) = MAX(50.E-6, MIN(t5(ix,1,kz), 10.E-3)) + ENDDO + ENDDO + ENDIF + ENDIF + + IF ( present(has_reqh) .and. present( re_hail ) ) THEN + IF ( has_reqh /= 0 ) THEN + DO kz = kts,kte + DO ix = its,ite + re_hail(ix,kz,jy) = MAX(50.E-6, MIN(t5(ix,1,kz), 40.E-3)) + ENDDO + ENDDO + ENDIF + ENDIF ENDIF ENDIF + IF ( present( hail_maxk1 ) .and. present( hail_max2d ) .and. nwp_diagflag ) THEN + DO ix = its,ite + hailmax1d(ix,1) = hail_max2d(ix,jy) + hailmaxk1(ix,1) = hail_maxk1(ix,jy) + ENDDO + + call hailmaxd(dtp,nx,ny,nz,an,na,nor,nor,alpha2d,dn1, & + hailmax1d,hailmaxk1,1 ) + DO ix = its,ite + hail_max2d(ix,jy) = hailmax1d(ix,1) + hail_maxk1(ix,jy) = hailmaxk1(ix,1) + ENDDO +! ENDIF + ENDIF ! transform concentrations back to mixing ratios DO il = lnb,na IF ( denscale(il) == 1 ) THEN DO kz = kts,kte DO ix = its,ite - an(ix,1,kz,il) = an(ix,1,kz,il)/dn(ix,kz,jy) + an(ix,1,kz,il) = an(ix,1,kz,il)/dn1(ix,1,kz) ! dn(ix,kz,jy) ENDDO ENDDO ENDIF @@ -2790,15 +3273,15 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw qv(ix,kz,jy) = an(ix,1,kz,lv) qc(ix,kz,jy) = an(ix,1,kz,lc) qr(ix,kz,jy) = an(ix,1,kz,lr) - IF ( present(qi) ) qi(ix,kz,jy) = an(ix,1,kz,li) + IF ( flag_qi ) qi(ix,kz,jy) = an(ix,1,kz,li) qs(ix,kz,jy) = an(ix,1,kz,ls) qh(ix,kz,jy) = an(ix,1,kz,lh) IF ( lhl > 1 ) qhl(ix,kz,jy) = an(ix,1,kz,lhl) IF ( lccn > 1 .and. is_aerosol_aware .and. flag_qnwfa ) THEN ! not used here - ELSEIF ( present( cn ) .and. lccn > 1 .and. .not. flag_qndrop) THEN - IF ( lccna > 1 .and. .not. present( cna ) ) THEN + ELSEIF ( flag_ccn .and. lccn > 1 .and. .not. flag_qndrop) THEN + IF ( lccna > 1 .and. .not. ( present( cna ) .and. f_cnatmp ) ) THEN cn(ix,kz,jy) = Max(0.0, an(ix,1,kz,lccna) ) ELSE cn(ix,kz,jy) = an(ix,1,kz,lccn) @@ -2816,6 +3299,21 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ENDIF ENDIF + IF ( lccnuf > 0 .and. flag_cnuf ) THEN + IF ( i_uf_or_ccn > 0 ) THEN ! UF are ccn and lccnuf is zero, so put cnuf into lccnuf to do decay + an(ix,1,kz,lccnuf) = Max(0.0, cnuf(ix,kz,jy) ) + ENDIF + IF ( decayufccn ) THEN + IF ( an(ix,1,kz,lccnuf) > ufbackground ) THEN + an(ix,1,kz,lccnuf) = an(ix,1,kz,lccnuf) - (an(ix,1,kz,lccnuf) - & + ufbackground)*(1.0 - exp(-dtp/ufccntimeconst)) + ENDIF + ENDIF + cnuf(ix,kz,jy) = an(ix,1,kz,lccnuf) + ENDIF + + + IF ( ipconc >= 5 ) THEN ccw(ix,kz,jy) = an(ix,1,kz,lnc) @@ -2826,6 +3324,11 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw IF ( lhl > 1 ) chl(ix,kz,jy) = an(ix,1,kz,lnhl) ENDIF + IF ( ipconc >= 6 ) THEN + IF ( lzr > 0 ) zrw(ix,kz,jy) = an(ix,1,kz,lzr) *zscaleinv + IF ( lzh > 0 ) zhw(ix,kz,jy) = an(ix,1,kz,lzh) *zscaleinv + IF ( lzhl > 0 ) zhl(ix,kz,jy) = an(ix,1,kz,lzhl)*zscaleinv + ENDIF @@ -2834,6 +3337,9 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw #if ( WRF_CHEM == 1 ) IF ( has_wetscav ) THEN + IF ( loopmax > 1 ) THEN + ! wrferror not supported + ENDIF IF ( PRESENT( rainprod ) ) rainprod(ix,kz,jy) = rainprod2d(ix,kz) IF ( PRESENT( evapprod ) ) evapprod(ix,kz,jy) = evapprod2d(ix,kz) ENDIF @@ -2841,10 +3347,14 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ENDDO ENDDO - + + ENDDO ! jy - IF ( invertccn .and. present( cn ) ) THEN ! hack to convert unactivated ccn back to activated + + + + IF ( invertccn .and. flag_ccn ) THEN ! hack to convert unactivated ccn back to activated DO jy = jts,jte DO kz = kts,kte DO ix = its,ite @@ -2854,6 +3364,17 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ENDDO ENDIF + IF ( lccnuf > 1 .and. flag_cnuf .and. ccnuf > 1.0 ) THEN + DO jy = jts,jte + DO kz = kts,kte + DO ix = its,ite + cnuf(ix,kz,jy) = qccnuf - cnuf(ix,kz,jy) + ENDDO + ENDDO + ENDDO + ENDIF + + @@ -3042,7 +3563,6 @@ END function GAMXINFDP ! ##################################################################### -! #ifdef Z3MOM real function gaminterp(ratio, alp, luindex, ilh) implicit none @@ -3086,7 +3606,6 @@ real function gaminterp(ratio, alp, luindex, ilh) ! ENDIF END FUNCTION gaminterp -! #endif /* Z3MOM */ ! ##################################################################### !**************************** GAML02 *********************** @@ -3136,7 +3655,7 @@ END FUNCTION GAML02 ! It is used for qiacr with the gamma of volume to calculate what ! fraction of drops exceed a certain size (this version is for 300 micron drops) (see zieglerstuff.nb) ! ********************************************************** - real FUNCTION GAML02d300(x) + real FUNCTION GAML02d300(x) implicit none integer ig, i, ii, n, np real x @@ -3429,7 +3948,7 @@ Function delabk(ba,bb,nua,nub,mua,mub,k) del = tmp - dgam*i IF ( i+1 > ngm0 ) THEN write(0,*) 'delabk: i+1 > ngm0!!!!',i,ngm0,nua,mua,tmp - STOP + STOP ENDIF g1pnua = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami ! write(91,*) 'delabk: g1pnua,gamma = ',g1pnua,Gamma_sp((1. + nua)/mua) @@ -3468,7 +3987,8 @@ Function delabk(ba,bb,nua,nub,mua,mub,k) RETURN END Function delabk - + + ! ##################################################################### ! @@ -3488,7 +4008,238 @@ end subroutine cld_cpu ! !-------------------------------------------------------------------------- ! - subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & +! ####################################################################### +! HAILMAXD - calculated maximum expected hail size +! ####################################################################### + subroutine hailmaxd(dtp,nx,ny,nz,an,na,nor,norz,alpha2d,dn, & + & hailmax1d,hailmaxk1,jslab ) +! +! Calculate maximum hail size from the tail of of the distribution. The value +! of thresh_conc sets the minimum concentration in the integral over (Dmax, Inf). +! This uses the lookup tables for incomplete gamma functions and simply search for +! the expected value (and linearly interpolate) on D. +! +! Written by ERM 7/2023 +! +! +! + implicit none + + integer nx,ny,nz,nor,norz,ngt,jgs,na,ia + integer id ! =1 use density, =0 no density +! integer :: its,ite ! x-range to calculate + + integer ng1 + parameter(ng1 = 1) + + real an(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz,na) + real dn(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz) + +! real gz(-nor+ng1:nz+nor),z1d(-nor+ng1:nz+nor,4) + real dtp + real alpha2d(-nor+1:nx+nor,1,-norz+1:nz+norz,3) ! array for PSD shape parameters + real :: hailmax1d(nx,ny),hailmaxk1(nx,ny) + integer infdo + integer jslab ! which line of xfall to use + + integer ix,jy,kz,ndfall,n,k,il,in + double precision :: tmp, ratio, del, g1palp + real, parameter :: dz = 200. + + real :: db1(nx,nz+1),dtz1(nz+1,nx,0:1),dz2dinv(nz+1,nx),db1inv(nx,nz+1) + + real :: rhovtzx(nz,nx) + + real :: alp, diam, diam1, hwdn + +! real, parameter :: cmin = 0.001 ! threshold number per m^3 for maximum diamter (threshold from diag_nwp) + DOUBLE PRECISION, PARAMETER:: thresh_conc = 0.0005d0 ! number conc. of graupel/hail per cubic meter + real :: cwchtmp,cwchltmp, maxdia + +!----------------------------------------------------------------------------- + + integer :: ixb, jyb, kzb + integer :: ixe, jye, kze + integer :: plo, phi + integer :: ialp, i, j + + logical :: debug_mpi = .TRUE. + +! ################################################################### + + + IF ( lh > 1 ) THEN + cwchtmp = ((3. + dnu(lh))*(2. + dnu(lh))*(1.0 + dnu(lh)))**(-1./3.) + ENDIF + IF ( lhl > 1 ) THEN + cwchltmp = ((3. + dnu(lhl))*(2. + dnu(lhl))*(1.0 + dnu(lhl)))**(-1./3.) + ENDIF + + + kzb = 1 + kze = nz + + ixb = 1 ! aliased its + ixe = nx ! aliased ite + + + jy = jslab + jgs = jy + + +! hailmax1d(:,jy) = 0.0 +! hailmaxk1(:,jy) = 0.0 + + if ( ndebug .gt. 0 ) write(0,*) 'dbg = 3a' + + +! first graupel, even if hail is also predicted, since graupel can sometime be large on its own + IF ( lh > 1 .and. lnh > 1 ) THEN + DO kz = kzb,kze + DO ix = ixb,ixe + IF ( an(ix,jy,kz,lh) .gt. qxmin(lh) .and. an(ix,jy,kz,lnh) .gt. thresh_conc ) THEN + IF ( lvh .gt. 1 ) THEN + hwdn = dn(ix,jy,kz)*an(ix,jy,kz,lh)/an(ix,jy,kz,lvh) + ELSE + hwdn = rho_qh + ENDIF + + tmp = 1. + alpha2d(ix,1,kz,2) + i = Int(dgami*(tmp)) + del = tmp - dgam*i + g1palp = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + + tmp = dn(ix,jy,kz)*an(ix,jy,kz,lh)/(hwdn*an(ix,jy,kz,lnh)) + diam = (6.0*tmp/pi)**(1./3.) + IF ( lzh > 1 ) THEN ! 3moment + cwchtmp = ((3. + alpha2d(ix,1,kz,2))*(2. + alpha2d(ix,1,kz,2))*(1.0 + alpha2d(ix,1,kz,2)))**(-1./3.) + ENDIF + diam1 = diam*cwchtmp ! characteristic diameter, i.e., 1/lambda + ! want cxd1 = thresh_conc + ! tmp = gaminterp(ratio,alpha(mgs,lh),1,1) + ! cxd1 = cx(mgs,lh)*(tmp)/g1palp + ! tmp = thresh_conc*g1palp/cx + ! + tmp = thresh_conc*g1palp/an(ix,jy,kz,lnh) + alp = alpha2d(ix,1,kz,2) + ! gamxinflu(i,j,luindex,ilh) + j = Int(Max(0.0,Min(maxalphalu,alp))*dqiacralphainv) + ratio = 0.0 + maxdia = 0.0 + ! eventually could replace with bisection search, but final value of i is usually small + ! compared to nqiacrratio + DO i = 0,nqiacrratio-1 + IF ( gamxinflu(i,j,1,1) >= tmp .and. tmp >= gamxinflu(i+1,j,1,1) ) THEN + ! interpolate here for FWIW + ratio = i*dqiacrratio + del = tmp - gamxinflu(i,j,1,1) + ratio = (float(i) + del/(gamxinflu(i+1,j,1,1) - gamxinflu(i,j,1,1)))*dqiacrratio + exit + ENDIF + ENDDO + + IF ( ratio > 0.0 ) THEN + maxdia = ratio*diam1 ! units of m + ENDIF + + IF ( kz == kzb ) THEN + hailmaxk1(ix,jy) = Max( maxdia, hailmaxk1(ix,jy) ) +! IF ( maxdia > 0.1 ) THEN +! IF ( an(ix,jy,kz,lh) > 1.e-4 ) THEN +! write(0,*) 'maxdia,tmp,alp,ratio,diam,diam1= ',maxdia,tmp,alp,ratio,diam*100.,diam1*100. +! write(0,*) 'hwdn, cxhl, qx, g1palp = ',hwdn, an(ix,jy,kz,lnhl), an(ix,jy,kz,lhl), g1palp +! write(0,*) 'j,gamxinflu(0,2,4) = ',j,gamxinflu(0,j,1,1),gamxinflu(2,j,1,1), & +! gamxinflu(4,j,1,1) +! ENDIF + ENDIF + + hailmax1d(ix,jy) = Max(maxdia, hailmax1d(ix,jy) ) + + ! + + ENDIF + + ENDDO + ENDDO + + ENDIF ! lh + +! And diam for hail if present + IF ( lhl > 1 .and. lnhl > 1 ) THEN + DO kz = kzb,kze + DO ix = ixb,ixe + IF ( an(ix,jy,kz,lhl) .gt. qxmin(lhl) .and. an(ix,jy,kz,lnhl) .gt. thresh_conc ) THEN + IF ( lvhl .gt. 1 ) THEN + hwdn = dn(ix,jy,kz)*an(ix,jy,kz,lhl)/an(ix,jy,kz,lvhl) + ELSE + hwdn = rho_qhl + ENDIF + + tmp = 1. + alpha2d(ix,1,kz,3) + i = Int(dgami*(tmp)) + del = tmp - dgam*i + g1palp = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + + tmp = dn(ix,jy,kz)*an(ix,jy,kz,lhl)/(hwdn*an(ix,jy,kz,lnhl)) + diam = (6.0*tmp/pi)**(1./3.) + IF ( lzhl > 1 ) THEN ! 3moment + cwchltmp = ((3. + alpha2d(ix,1,kz,3))*(2. + alpha2d(ix,1,kz,3))*(1.0 + alpha2d(ix,1,kz,3)))**(-1./3.) + ENDIF + diam1 = diam*cwchltmp ! characteristic diameter, i.e., 1/lambda + ! want cxd1 = thresh_conc + ! tmp = gaminterp(ratio,alpha(mgs,lh),1,1) + ! cxd1 = cx(mgs,lh)*(tmp)/g1palp + ! tmp = thresh_conc*g1palp/cx + ! + tmp = thresh_conc*g1palp/an(ix,jy,kz,lnhl) + alp = alpha2d(ix,1,kz,3) + ! gamxinflu(i,j,luindex,ilh) + j = Int(Max(0.0,Min(maxalphalu,alp))*dqiacralphainv) + ratio = 0.0 + maxdia = 0.0 + ! eventually could replace with bisection search, but final value of i is usually small + ! compared to nqiacrratio + DO i = 0,nqiacrratio-1 + IF ( gamxinflu(i,j,1,1) >= tmp .and. tmp >= gamxinflu(i+1,j,1,1) ) THEN + ! interpolate here for FWIW + ratio = i*dqiacrratio + del = tmp - gamxinflu(i,j,1,1) + ratio = (float(i) + del/(gamxinflu(i+1,j,1,1) - gamxinflu(i,j,1,1)))*dqiacrratio + exit + ENDIF + ENDDO + + IF ( ratio > 0.0 ) THEN + maxdia = ratio*diam1 ! units of m + ENDIF + + IF ( kz == kzb ) THEN + hailmaxk1(ix,jy) = Max( maxdia, hailmaxk1(ix,jy) ) +! IF ( maxdia > 0.1 ) THEN +! IF ( an(ix,jy,kz,lhl) > 1.e-4 ) THEN +! write(0,*) 'maxdia,tmp,alp,ratio,diam,diam1= ',maxdia,tmp,alp,ratio,diam*100.,diam1*100. +! write(0,*) 'hwdn, cxhl, qx, g1palp = ',hwdn, an(ix,jy,kz,lnhl), an(ix,jy,kz,lhl), g1palp +! write(0,*) 'j,gamxinflu(0,2,4) = ',j,gamxinflu(0,j,1,1),gamxinflu(2,j,1,1), & +! gamxinflu(4,j,1,1) +! ENDIF + ENDIF + + hailmax1d(ix,jy) = Max(maxdia, hailmax1d(ix,jy) ) + + ! + + ENDIF + + ENDDO + ENDDO + + ENDIF + + + END SUBROUTINE HAILMAXD +! ####################################################################### +! ####################################################################### + subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & & t0,t7,infdo,jslab,its,jts, & & timesed1,timesed2,timesed3,zmaxsed,timesetvt) ! used for timing ! @@ -3517,7 +4268,7 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & ! real gz(-nor+ng1:nz+nor),z1d(-nor+ng1:nz+nor,4) real dtp real xfall(nx,ny,na) ! array for stuff landing on the ground - real xfall0(nx,ny) ! dummy array +! real xfall0(nx,ny) ! dummy array integer infdo integer jslab ! which line of xfall to use @@ -3525,47 +4276,81 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & real tmp, vtmax, dtptmp, dtfrac real, parameter :: dz = 200. - real :: xvt(nz+1,nx,3,lc:lhab) ! (nx,nz,2,lc:lhab) ! 1=mass-weighted, 2=number-weighted - real :: tmpn(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz) - real :: tmpn2(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz) - real :: z(-nor+ng1:nx+nor,-norz+ng1:nz+norz,lr:lhab) - real :: db1(nx,nz+1),dtz1(nz+1,nx,0:1),dz2dinv(nz+1,nx),db1inv(nx,nz+1) +! real :: xvt(nz+1,nx,3,lc:lhab) ! (nx,nz,2,lc:lhab) ! 1=mass-weighted, 2=number-weighted +! real :: tmpn(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz) +! real :: tmpn2(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz) +! real :: z(-nor+ng1:nx+nor,-norz+ng1:nz+norz,lr:lhab) +! real :: db1(nx,nz+1),dtz1(nz+1,nx,0:1),dz2dinv(nz+1,nx),db1inv(nx,nz+1) - real :: rhovtzx(nz,nx) +! real :: rhovtzx(nz,nx) + + real, allocatable :: db1(:,:), dtz1(:,:,:),dz2dinv(:,:),db1inv(:,:) ! db1(nx,nz+1),dtz1(nz+1,nx,0:1),dz2dinv(nz+1,nx),db1inv(nx,nz+1) + real, allocatable :: rhovtzx(:,:) + real, allocatable :: xfall0(:,:), xvt(:,:,:,:),tmpn(:,:,:),tmpn2(:,:,:),z(:,:,:) double precision :: timesed1,timesed2,timesed3, zmaxsed,timesetvt,dummy double precision :: dt1,dt2,dt3,dt4 - integer,parameter :: ngs = 128 + integer :: ngs ! = 512 integer :: ngscnt,mgs,ipconc0 - real :: qx(ngs,lv:lhab) - real :: qxw(ngs,ls:lhab) - real :: cx(ngs,lc:lhab) - real :: xv(ngs,lc:lhab) - real :: vtxbar(ngs,lc:lhab,3) - real :: xmas(ngs,lc:lhab) - real :: xdn(ngs,lc:lhab) - real :: xdia(ngs,lc:lhab,3) - real :: vx(ngs,li:lhab) - real :: alpha(ngs,lc:lhab) - real :: zx(ngs,lr:lhab) - logical :: hasmass(nx,lc+1:lhab) - - integer igs(ngs),kgs(ngs) - - real rho0(ngs),temcg(ngs) - - real temg(ngs) - - real rhovt(ngs) - - real cwnc(ngs),cinc(ngs) - real fadvisc(ngs),cwdia(ngs),cipmas(ngs) - - real cimasn,cimasx,cnina(ngs),cimas(ngs) - - real cnostmp(ngs) +! real :: qx(ngs,lv:lhab) +! real :: qxw(ngs,ls:lhab) +! real :: cx(ngs,lc:lhab) +! real :: xv(ngs,lc:lhab) +! real :: vtxbar(ngs,lc:lhab,3) +! real :: xmas(ngs,lc:lhab) +! real :: xdn(ngs,lc:lhab) +! real :: xdia(ngs,lc:lhab,3) +! real :: vx(ngs,li:lhab) +! real :: alpha(ngs,lc:lhab) +! real :: zx(ngs,lr:lhab) +! logical :: hasmass(nx,lc+1:lhab) +! +! integer igs(ngs),kgs(ngs) +! +! real rho0(ngs),temcg(ngs) +! +! real temg(ngs) +! +! real rhovt(ngs) +! +! real cwnc(ngs),cinc(ngs) +! real fadvisc(ngs),cwdia(ngs),cipmas(ngs) +! +! real cimasn,cimasx,cnina(ngs),cimas(ngs) +! +! real cnostmp(ngs) + + real, allocatable :: qx(:,:) + real, allocatable :: qxw(:,:) + real, allocatable :: cx(:,:) + real, allocatable :: xv(:,:) + real, allocatable :: vtxbar(:,:,:) + real, allocatable :: xmas(:,:) + real, allocatable :: xdn(:,:) + real, allocatable :: xdia(:,:,:) + real, allocatable :: vx(:,:) + real, allocatable :: alpha(:,:) + real, allocatable :: zx(:,:) + logical, allocatable :: hasmass(:,:) + + integer, allocatable :: igs(:),kgs(:) + + real, allocatable :: rho0(:),temcg(:) + + real, allocatable :: temg(:) + + real, allocatable :: rhovt(:) + + real, allocatable :: cwnc(:),cinc(:) + real, allocatable :: fadvisc(:),cwdia(:),cipmas(:) + + real, allocatable :: cnina(:),cimas(:) + + real, allocatable :: cnostmp(:) + + real :: cimasn,cimasx !----------------------------------------------------------------------------- @@ -3579,7 +4364,30 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & ! ################################################################### - + allocate( db1(nx,nz+1),dtz1(nz+1,nx,0:1),dz2dinv(nz+1,nx),db1inv(nx,nz+1),rhovtzx(nz,nx) ) + allocate( xfall0(nx,ny), xvt(nz+1,nx,3,lc:lhab), tmpn(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz) ) + allocate( tmpn2(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz), z(-nor+ng1:nx+nor,-norz+ng1:nz+norz,lr:lhab)) + + ngs = nz+3 + + allocate( qx(ngs,lv:lhab), & + qxw(ngs,ls:lhab), & + cx(ngs,lc:lhab), & + xv(ngs,lc:lhab), & + vtxbar(ngs,lc:lhab,3), & + xmas(ngs,lc:lhab), & + xdn(ngs,lc:lhab), & + xdia(ngs,lc:lhab,3), & + vx(ngs,li:lhab), & + alpha(ngs,lc:lhab), & + zx(ngs,lr:lhab), & + hasmass(nx,lc+1:lhab), & + igs(ngs),kgs(ngs), & + rho0(ngs),temcg(ngs),temg(ngs), rhovt(ngs), & + cwnc(ngs),cinc(ngs), & + fadvisc(ngs),cwdia(ngs),cipmas(ngs), & + cnina(ngs),cimas(ngs), & + cnostmp(ngs) ) kzb = 1 kze = nz @@ -3717,13 +4525,15 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & DO n = 1,ndfall - IF ( do_accurate_sedimentation .and. n .ge. 2 .and. ( n == n*(n/interval_sedi_vt) ) ) THEN + IF ( do_accurate_sedimentation .and. n .ge. 2 .and. ( n == interval_sedi_vt*(n/interval_sedi_vt) ) ) THEN ! ! zero the precip flux arrays (2d) ! -! xvt(:,:,:,il) = 0.0 dummy = 0.d0 + + xvt(kzb:kze,ix,1:3,il) = 0.0 ! reset to zero because routine will only compute points with q > qmin + call ziegfall1d(nx,ny,nz,nor,norz,na,dtp,jgs,ix, & & xvt, rhovtzx, & & an,dn,ipconc,t0,t7,cwmasn,cwmasx, & @@ -3749,7 +4559,8 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & IF ( il >= lr .and. ( infall .eq. 3 .or. infall .eq. 4 ) .and. ln(il) > 0 ) THEN - IF ( (il .eq. lr .and. irfall .eq. infall .and. lzr < 1) .or. (il .ge. lh .and. lz(il) .lt. 1 ) ) THEN + IF ( (il .eq. lr .and. irfall .eq. infall .and. lzr < 1) .or. & + (il .ge. lh .and. lz(il) .lt. 1 ) .or. (il == ls .and. isfall == infall ) ) THEN call calczgr1d(nx,ny,nz,nor,na,an,ixe,kze, & & z,db1,jgs,ipconc, dnu(il), il, ln(il), qxmin(il), xvmn(il), xvmx(il), lvol(il), xdn0(il), ix ) ENDIF @@ -3774,6 +4585,14 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & ENDIF ENDIF +! reflectivity + + IF ( ipconc .ge. 6 ) THEN + IF ( lz(il) .gt. 1 ) THEN + call fallout1d(nx,ny,nz,nor,na,dtptmp,dtfrac,jgs,xvt(1,1,3,il), & + & an,db1,lz(il),0,xfall,dtz1,ix) + ENDIF + ENDIF if (ndebug .gt. 0 ) write(0,*) 'dbg = 3d' @@ -3787,9 +4606,11 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & ! to put a lower bound on number conc. ! - IF ( ( infall .eq. 3 .or. infall .eq. 4 ) .and. ( il .eq. lh .or. il .eq. lhl .or. & + IF ( ( infall .eq. 3 .or. infall .eq. 4 ) .and. ( (il == ls .and. isfall .eq. infall ) & + & .or. il .eq. lh .or. il .eq. lhl .or. il == lf .or. & & ( il .eq. lr .and. irfall .eq. infall) ) ) THEN + ! set up for method I+II DO kz = kzb,kze ! DO ix = ixb,ixe tmpn2(ix,jy,kz) = z(ix,kz,il) @@ -3802,7 +4623,7 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & ENDDO ELSE - + ! set up for method II only DO kz = kzb,kze ! DO ix = ixb,ixe tmpn(ix,jy,kz) = an(ix,jy,kz,ln(il)) @@ -3831,7 +4652,8 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & xfall0(:,jgs) = 0.0 IF ( ( infall .eq. 3 .or. infall .eq. 4 ) .and. & - & ( il .ge. lh .or. (il .eq. lr .and. irfall .eq. infall) ) ) THEN + & ( il .ge. lh .or. (il .eq. lr .and. irfall .eq. infall) & + .or. (il .eq. ls .and. isfall .eq. infall) ) ) THEN call fallout1d(nx,ny,nz,nor,1,dtptmp,dtfrac,jgs,xvt(1,1,3,il), & & tmpn2,db1,1,0,xfall0,dtz1,ix) call fallout1d(nx,ny,nz,nor,1,dtptmp,dtfrac,jgs,xvt(1,1,1,il), & @@ -3842,12 +4664,12 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & ENDIF IF ( ( infall .eq. 3 .or. infall .eq. 4 ) .and. ( (il .eq. lr .and. irfall .eq. infall) & - & .or. il .ge. lh ) ) THEN + & .or. il .ge. lh .or. (il == ls .and. isfall .eq. infall ) ) ) THEN ! "Method I" - dbz correction call calcnfromz1d(nx,ny,nz,nor,na,an,tmpn2,ixe,kze, & & z,db1,jgs,ipconc, dnu(il), il, ln(il), qxmin(il), xvmn(il), xvmx(il),tmpn, & - & lvol(il), rho_qh, infall, ix) + & lvol(il), xdn0(il), infall, ix) ELSEIF ( infall .eq. 5 .and. il .ge. lh .or. ( il == lr .and. irfall == 5 ) ) THEN @@ -3858,7 +4680,7 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & ! ENDDO ENDDO - ELSEIF ( .not. (il .eq. lr .and. irfall .eq. 0) ) THEN + ELSEIF ( .not. (il .eq. lr .and. irfall .eq. 0) .and. .not. (il .eq. ls .and. isfall .eq. 0) ) THEN ! "Method II" M-wgt N-fallout correction DO kz = kzb,kze @@ -3885,8 +4707,29 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & ENDDO ! ix + deallocate( db1,dtz1,dz2dinv,db1inv,rhovtzx ) + deallocate( xfall0, xvt, tmpn ) + deallocate( tmpn2, z) + + deallocate( qx, & + qxw, & + cx, & + xv, & + vtxbar, & + xmas, & + xdn, & + xdia, & + vx, & + alpha, & + zx, & + hasmass, & + igs,kgs, & + rho0,temcg,temg, rhovt, & + cwnc,cinc, & + fadvisc,cwdia,cipmas, & + cnina,cimas, & + cnostmp ) - RETURN END SUBROUTINE SEDIMENT1D @@ -4040,13 +4883,14 @@ subroutine calczgr1d(nx,ny,nz,nor,na,a,ixe,kze, & integer ix,jy,kz - real vr,qr,nrx,rd,xv,g1,zx,chw,xdn + real vr,qr,nrx,rd,xv,g1,zx,chw,xdn,ynu jy = jgs ix = ixcol - IF ( l .eq. lh .or. l .eq. lhl .or. ( l .eq. lr .and. imurain == 1 ) ) THEN + IF ( l .eq. lh .or. l .eq. lhl .or. ( l .eq. lr .and. imurain == 1 ) & + .or. ( l .eq. ls .and. imusnow == 1 ) ) THEN DO kz = 1,kze @@ -4096,16 +4940,19 @@ subroutine calczgr1d(nx,ny,nz,nor,na,a,ixe,kze, & ENDDO - ELSEIF ( l .eq. lr .and. imurain == 3) THEN + ELSEIF ( (l == ls .and. imusnow == 3) .or. ( l .eq. lr .and. imurain == 3 ) ) THEN - xdn = 1000. + xdn = rho_qx ! 1000. + IF ( l == ls ) ynu = snu + IF ( l == lr ) ynu = rnu DO kz = 1,kze + IF ( a(ix,jy,kz,l) .gt. qmin .and. a(ix,jy,kz,ln) .gt. 1.e-15 ) THEN vr = db(ix,kz)*a(ix,jy,kz,l)/(xdn*a(ix,jy,kz,ln)) -! z(ix,kz,l) = 3.6e18*(rnu+2.0)*a(ix,jy,kz,ln)*vr**2/(rnu+1.0) - z(ix,kz,l) = 3.6*(rnu+2.0)*a(ix,jy,kz,ln)*vr**2/(rnu+1.0) +! z(ix,kz,l) = 3.6e18*(ynu+2.0)*a(ix,jy,kz,ln)*vr**2/(ynu+1.0) + z(ix,kz,l) = 3.6*(ynu+2.0)*a(ix,jy,kz,ln)*vr**2/(ynu+1.0) ! qr = a(ix,jy,kz,lr) ! nrx = a(ix,jy,kz,lnr) @@ -4319,13 +5166,17 @@ END subroutine calcnfromz1d ! ############################################################################## ! ! Subroutine to calculate number concentrations from initial state that has only mixing ratio. -! N will be in #/kg, NOT #/m^3, since sedimentation is done next. -! +! Output N will be in #/m^3 in 'an' array, since sedimentation is done next. +! Output ccw,cci etc. will be in #/kg ! ! 10.27.2015: Added hail calculation ! - subroutine calcnfromq(nx,ny,nz,an,na,nor,norz,dn) + subroutine calcnfromq(nx,ny,nz,an,na,nor,norz,dn, & + & qcw,qci,qsw,qrw,qhw,qhl, & + & ccw,cci,csw,crw,chw,chl, & + & cccn,cccna, vhw,vhl,qv,spechum, invertccn_flag, cwmasin ) + implicit none @@ -4335,6 +5186,12 @@ subroutine calcnfromq(nx,ny,nz,an,na,nor,norz,dn) real an(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz,na) ! scalars (q, N, Z) real dn(nx,nz+1) ! air density + + real, optional, dimension(nx,nz), intent(inout) :: qcw,qci,qsw,qrw,qhw,qhl, & + ccw,cci,csw,crw,chw,chl, & + cccn,cccna,vhw,vhl,qv, spechum + logical, optional, intent(in) :: invertccn_flag + real, optional :: cwmasin integer ixe,kze real alpha @@ -4346,7 +5203,7 @@ subroutine calcnfromq(nx,ny,nz,an,na,nor,norz,dn) integer ix,jy,kz - double precision vr,q,nrx,nrx2,rd,g1h,g1hl,g1r,g1s,zx,chw,z,znew,zt,zxt,n1,laminv1 + double precision vr,q,nrx,nrx2,rd,g1h,g1hl,g1r,g1s,zx,z,znew,zt,zxt,n1,laminv1 double precision :: zr, zs, zh, dninv real, parameter :: xn0s = 3.0e6, xn0r = 8.0e6, xn0h = 2.0e5, xn0hl = 4.0e4 real, parameter :: xdnr = 1000., xdns = 100. ,xdnh = 700.0, xdnhl = 900.0 @@ -4359,11 +5216,24 @@ subroutine calcnfromq(nx,ny,nz,an,na,nor,norz,dn) real, parameter :: xgms=xdnh*0.523599*(300.e-6)**3 ! mks (300 micron diam sphere approx) real, parameter :: cwmas09 = 1000.*0.523599*(2.*9.e-6)**3 ! mass of 9-micron radius droplet - real xv,xdn + real xv,xdn,cwmasinv integer :: ndbz, nmwgt, nnwgt, nwlessthanz + double precision :: mixconv, mixconvqv, qsmax,qsmax2,qsmax3,qsmax4 + logical :: invertccn_local ! ------------------------------------------------------------------ + IF ( present( invertccn_flag ) ) THEN + invertccn_local = invertccn_flag + ELSE + invertccn_local = .false. + ENDIF + + IF ( present( cwmasin ) ) THEN + cwmasinv = 1.0/cwmasin + ELSE + cwmasinv = 1.0/cwmas09 + ENDIF jy = 1 @@ -4382,18 +5252,59 @@ subroutine calcnfromq(nx,ny,nz,an,na,nor,norz,dn) ENDIF g1s = (snu+2.0)/(snu+1.0) - + qsmax = 0 + qsmax2 = 0 + qsmax3 = 0 + qsmax4 = 0 +! IF ( .not. present( qcw ) ) THEN DO kz = 1,nz DO ix = 1,nx ! ixcol +! qv_mp = spechum/(1.0_kind_phys-spechum) +! IF ( convertdry ) THEN +! qc_mp = qc/(1.0_kind_phys-spechum) + mixconv = 1 + IF ( present( spechum ) ) THEN ! convert to "dry" mixing ratios + an(ix,jy,kz,lv) = spechum(ix,kz)/(1.0d0 - spechum(ix,kz)) + mixconv = 1.0d0/(1.0d0 - spechum(ix,kz)) + ELSE + mixconv = 1.0d0 + ENDIF + IF ( present( qv ) ) an(ix,jy,kz,lv) = qv(ix,kz) ! assume qv is "dry" mixing ratio if passed in + IF ( present( qcw ) ) an(ix,jy,kz,lc) = qcw(ix,kz)*mixconv + IF ( present( qrw ) ) an(ix,jy,kz,lr) = qrw(ix,kz)*mixconv + IF ( present( qci ) ) an(ix,jy,kz,li) = qci(ix,kz)*mixconv + IF ( present( qsw ) ) THEN + an(ix,jy,kz,ls) = qsw(ix,kz)*mixconv +! qsmax = Max( qsmax, qsw(ix,kz) ) +! qsmax2 = Max( qsmax2, an(ix,jy,kz,ls) ) + ENDIF + IF ( present( qhw ) ) an(ix,jy,kz,lh) = qhw(ix,kz)*mixconv + IF ( lhl > 1 .and. present( qhl ) ) an(ix,jy,kz,lhl) = qhl(ix,kz)*mixconv + IF ( present( ccw ) ) an(ix,jy,kz,lnc) = ccw(ix,kz)*mixconv*dn(ix,kz) + IF ( present( crw ) ) an(ix,jy,kz,lnr) = crw(ix,kz)*mixconv*dn(ix,kz) + IF ( present( cci ) ) an(ix,jy,kz,lni) = cci(ix,kz)*mixconv*dn(ix,kz) + IF ( present( csw ) ) an(ix,jy,kz,lns) = csw(ix,kz)*mixconv*dn(ix,kz) + IF ( present( chw ) ) an(ix,jy,kz,lnh) = chw(ix,kz)*mixconv*dn(ix,kz) + IF ( lhl > 1 .and. present( chl ) ) an(ix,jy,kz,lnhl) = chl(ix,kz)*mixconv*dn(ix,kz) + IF ( lvh > 1 .and. present( vhw ) ) an(ix,jy,kz,lvh) = vhw(ix,kz)*mixconv + IF ( lvhl > 1 .and. present( vhl ) ) an(ix,jy,kz,lvhl) = vhl(ix,kz)*mixconv + IF ( lccn > 1 .and. present( cccn ) ) an(ix,jy,kz,lccn) = cccn(ix,kz)*mixconv*dn(ix,kz) + IF ( lccna > 1 .and. present( cccna ) ) an(ix,jy,kz,lccna) = cccna(ix,kz)*mixconv + dninv = 1./dn(ix,kz) +! IF ( .not. present( qcw ) ) THEN ! Cloud droplets IF ( lnc > 1 ) THEN IF ( an(ix,jy,kz,lnc) <= cxmin .and. an(ix,jy,kz,lc) > qxmin_init(lc) ) THEN - an(ix,jy,kz,lnc) = Min(qccn, an(ix,jy,kz,lc)/cwmas09 )*dn(ix,kz) + an(ix,jy,kz,lnc) = Min(qccn, an(ix,jy,kz,lc)*cwmasinv )*dn(ix,kz) + + IF ( invertccn_local ) THEN + an(ix,jy,kz,lccn) = an(ix,jy,kz,lccn) + an(ix,jy,kz,lnc) + ELSE IF ( lccn > 1 .and. lccna < 1 ) THEN an(ix,jy,kz,lccn) = an(ix,jy,kz,lccn) - an(ix,jy,kz,lnc) @@ -4401,6 +5312,7 @@ subroutine calcnfromq(nx,ny,nz,an,na,nor,norz,dn) IF ( lccna > 1 ) THEN an(ix,jy,kz,lccna) = an(ix,jy,kz,lccna) + an(ix,jy,kz,lnc) ENDIF + ENDIF ELSEIF ( an(ix,jy,kz,lc) <= qxmin(lc) .or. & ( an(ix,jy,kz,lnc) <= cxmin .and. an(ix,jy,kz,lc) <= qxmin_init(lc)) ) THEN @@ -4449,6 +5361,15 @@ subroutine calcnfromq(nx,ny,nz,an,na,nor,norz,dn) ENDIF ENDIF + IF ( lzr > 1 ) THEN ! set reflectivity moment + IF ( an(ix,jy,kz,lr) > qxmin_init(lr) .and. an(ix,jy,kz,lzr) < zxmin .and. & + an(ix,jy,kz,lnr) > cxmin ) THEN + q = an(ix,jy,kz,lr) + nrx = an(ix,jy,kz,lnr) + an(ix,jy,kz,lzr) = 36.*g1r*dn(ix,kz)**2*q**2/(pi**2*xdnr**2*nrx) ! *dninv + ENDIF + ENDIF + ! snow IF ( lns > 1 ) THEN IF ( an(ix,jy,kz,lns) <= 0.1*cxmin .and. an(ix,jy,kz,ls) > qxmin_init(ls) ) THEN @@ -4511,6 +5432,15 @@ subroutine calcnfromq(nx,ny,nz,an,na,nor,norz,dn) ENDIF ENDIF + IF ( lzh > 1 ) THEN ! set reflectivity moment + IF ( an(ix,jy,kz,lh) > qxmin_init(lh) .and. an(ix,jy,kz,lzh) < zxmin .and. & + an(ix,jy,kz,lnh) > cxmin ) THEN + q = an(ix,jy,kz,lh) + nrx = an(ix,jy,kz,lnh) + an(ix,jy,kz,lzh) = 36.*g1h*dn(ix,kz)**2*q**2/(pi**2*xdnh**2*nrx) ! *dninv + ENDIF + ENDIF + ! hail IF ( lnhl > 1 .and. lhl > 1 ) THEN @@ -4531,7 +5461,6 @@ subroutine calcnfromq(nx,ny,nz,an,na,nor,norz,dn) an(ix,jy,kz,lnhl) = nrx ! *dninv ! convert to number mixing ratio - ELSEIF ( an(ix,jy,kz,lhl) <= qxmin(lhl) .or. & ( an(ix,jy,kz,lnhl) <= cxmin .and. an(ix,jy,kz,lhl) <= qxmin_init(lhl)) ) THEN @@ -4540,12 +5469,68 @@ subroutine calcnfromq(nx,ny,nz,an,na,nor,norz,dn) ENDIF ENDIF - - ENDDO ! ix - ENDDO ! kz - - RETURN - + + IF ( lzhl > 1 ) THEN ! set reflectivity moment + IF ( an(ix,jy,kz,lhl) > qxmin_init(lhl) .and. an(ix,jy,kz,lzhl) < zxmin .and. & + an(ix,jy,kz,lnhl) > cxmin ) THEN + q = an(ix,jy,kz,lhl) + nrx = an(ix,jy,kz,lnhl) + an(ix,jy,kz,lzhl) = 36.*g1hl*dn(ix,kz)**2*q**2/(pi**2*xdnhl**2*nrx) ! *dninv + ENDIF + ENDIF + + +! ENDIF + +! spechum = qv_mp/(1.0_kind_phys+qv_mp) +! IF ( convertdry ) THEN +! qc = qc_mp/(1.0_kind_phys+qv_mp) + mixconvqv = 1 + IF ( present( spechum ) ) THEN ! convert back to "dry+vapor" mixing ratios + !an(ix,jy,kz,lv) = spechum(ix,kz)/(1.0d0 - spechum(ix,kz)) + mixconvqv = 1.0d0/(1.0d0 + an(ix,jy,kz,lv)) + spechum(ix,kz) = an(ix,jy,kz,lv)*mixconvqv + ELSE + mixconvqv = 1.0d0 + ENDIF + + IF ( present( qv ) ) qv(ix,kz) = an(ix,jy,kz,lv) + IF ( present( qcw ) ) qcw(ix,kz) = an(ix,jy,kz,lc)*mixconvqv + IF ( present( qrw ) ) qrw(ix,kz) = an(ix,jy,kz,lr)*mixconvqv + IF ( present( qci ) ) qci(ix,kz) = an(ix,jy,kz,li)*mixconvqv + IF ( present( qsw ) ) THEN + qsw(ix,kz) = an(ix,jy,kz,ls)*mixconvqv +! qsmax3 = Max( qsmax3, qsw(ix,kz) ) +! qsmax4 = Max( qsmax4, an(ix,jy,kz,ls) ) + ENDIF + IF ( present( qhw ) ) qhw(ix,kz) = an(ix,jy,kz,lh)*mixconvqv + IF ( lhl > 1 .and. present( qhl ) ) qhl(ix,kz) = an(ix,jy,kz,lhl)*mixconvqv + IF ( present( ccw ) ) ccw(ix,kz) = an(ix,jy,kz,lnc)*mixconvqv*dninv + IF ( present( crw ) ) crw(ix,kz) = an(ix,jy,kz,lnr)*mixconvqv*dninv + IF ( present( cci ) ) cci(ix,kz) = an(ix,jy,kz,lni)*mixconvqv*dninv + IF ( present( csw ) ) csw(ix,kz) = an(ix,jy,kz,lns)*mixconvqv*dninv + IF ( present( chw ) ) chw(ix,kz) = an(ix,jy,kz,lnh)*mixconvqv*dninv + IF ( lhl > 1 .and. present( chl ) ) chl(ix,kz) = an(ix,jy,kz,lnhl)*mixconvqv*dninv + IF ( lvh > 1 .and. present( vhw ) ) vhw(ix,kz) = an(ix,jy,kz,lvh)*mixconvqv + IF ( lvhl > 1 .and. present( vhl ) ) vhl(ix,kz) = an(ix,jy,kz,lvhl)*mixconvqv + IF ( lccn > 1 .and. present( cccn ) ) cccn(ix,kz) = an(ix,jy,kz,lccn)*mixconvqv*dninv + IF ( lccna > 1 .and. present( cccna ) ) cccna(ix,kz) = an(ix,jy,kz,lccna)*mixconvqv + + + ENDDO ! ix + ENDDO ! kz +! ELSE +! write(0,*) 'calcnfromq: lv = ',lv,lc,lr,li,ls,lh,lvh,lhl,lccn,lccna +! write(0,*) 'calcnfromq: nx,ny,nz,na = ',nx,ny,nz,na +! +! ENDIF + +! IF ( present( qsw ) ) THEN +! write(0,*) 'calcnfromq: qsmax = ',qsmax,qsmax2,qsmax3,qsmax4 +! ENDIF + + RETURN + END subroutine calcnfromq ! ############################################################################## @@ -4661,6 +5646,9 @@ subroutine calcnfromcuten(nx,ny,nz,an,anold,na,nor,norz,dn) anold(ix,jy,kz,lnr) = anold(ix,jy,kz,lnr) + an(ix,jy,kz,lr)/xmass ENDIF + IF ( lzr > 1 ) THEN ! set reflectivity moment + an(ix,jy,kz,lzr) = 36.*g1r*dn(ix,kz)**2*q**2/(pi**2*xdnr**2*nrx) ! *dninv + ENDIF ENDIF ENDIF @@ -4711,6 +5699,9 @@ subroutine calcnfromcuten(nx,ny,nz,an,anold,na,nor,norz,dn) ! ! an(ix,jy,kz,lnh) = nrx ! *dninv ! convert to number mixing ratio ! +! IF ( lzh > 1 ) THEN ! set reflectivity moment +! an(ix,jy,kz,lzh) = 36.*g1h*dn(ix,kz)**2*q**2/(pi**2*xdnh**2*nrx) ! *dninv +! ENDIF ! ENDIF ! ENDIF ! @@ -4734,6 +5725,9 @@ subroutine calcnfromcuten(nx,ny,nz,an,anold,na,nor,norz,dn) ! ! an(ix,jy,kz,lnhl) = nrx ! *dninv ! convert to number mixing ratio ! +! IF ( lzhl > 1 ) THEN ! set reflectivity moment +! an(ix,jy,kz,lzhl) = 36.*g1hl*dn(ix,kz)**2*q**2/(pi**2*xdnhl**2*nrx) ! *dninv +! ENDIF ! ENDIF ! ENDIF @@ -4750,7 +5744,9 @@ END subroutine calcnfromcuten SUBROUTINE calc_eff_radius & & (nx,ny,nz,na,jyslab & & ,nor,norz & - & ,t1,t2,t3 & + & ,t1,t2,t3,t4,t5,t6, f_t4, f_t5,f_t6 & + & ,qcw,qci,qsw,qrw & + & ,ccw,cci,csw,crw & & ,an,dn ) implicit none @@ -4766,18 +5762,19 @@ SUBROUTINE calc_eff_radius & ! external temporary arrays ! - real t1(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz) - real t2(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz) - real t3(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz) - + real,optional :: t1(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz) + real,optional :: t2(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz) + real,optional :: t3(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz) + real,optional :: t4(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz) + real,optional :: t5(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz) + real,optional :: t6(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz) + logical, optional :: f_t4, f_t5, f_t6 ! flags to fill t4/t5/t6 for rain/graupel/hail - real an(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz,na) + real, optional :: an(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz,na) real dn(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz) - - + real, optional, dimension(nx,nz) :: qcw,qci,qsw,qrw,ccw,cci,csw,crw - ! local real pb(-norz+ng1:nz+norz) @@ -4809,8 +5806,13 @@ SUBROUTINE calc_eff_radius & real :: alpha(ngs,lc:lhab) real :: gamc1,gamc2,gami1,gami2,gams1,gams2, factor_c, factor_i, factor_s - real :: lam_c, lam_i, lam_s + real :: lam_c, lam_i, lam_s, lam_r, lam_h, lam_hl + real :: gamr1,gamr2,gamh1,gamh2,factor_r,factor_h,factor_hl integer :: il + real :: hwdn,hldn + double precision :: numh, numhl,denomh,denomhl + + logical :: flag_t4, flag_t5, flag_t6 ! ------------------------------------------------------------------------------- @@ -4825,6 +5827,28 @@ SUBROUTINE calc_eff_radius & nzend = nz kzbeg = 1 nzbeg = 1 + + flag_t4 = .false. + flag_t5 = .false. + flag_t6 = .false. + + IF ( present(f_t4) ) THEN + IF ( present(f_t4) ) THEN + flag_t4 = f_t4 + ENDIF + ENDIF + + IF ( present(f_t5) ) THEN + IF ( present(f_t5) ) THEN + flag_t5 = f_t5 + ENDIF + ENDIF + + IF ( present(f_t6) ) THEN + IF ( present(f_t6) ) THEN + flag_t6 = f_t6 + ENDIF + ENDIF jy = 1 pb(:) = 0.0 @@ -4836,11 +5860,24 @@ SUBROUTINE calc_eff_radius & gami2 = 1. ! Gamma[1 + alphac] gams1 = Gamma_sp(2. + snu) gams2 = Gamma_sp(1. + snu) + gamr1 = Gamma_sp(2. + rnu) + gamr2 = Gamma_sp(1. + rnu) factor_c = (1. + cnu)*Gamma_sp(1. + cnu)/Gamma_sp(5./3. + cnu) factor_i = (1. + cinu)*Gamma_sp(1. + cinu)/Gamma_sp(5./3. + cinu) factor_s = (1. + snu)*Gamma_sp(1. + snu)/Gamma_sp(5./3. + snu) + IF ( present(t4) ) THEN + IF ( imurain == 3 ) THEN + factor_r = (1. + rnu)*Gamma_sp(1. + rnu)/Gamma_sp(5./3. + rnu) + ELSE + factor_r = ((Pi*(alphar+3.)*(alphar+1.)*(alphar+1.))/6.)**(1./3.) + ENDIF + ENDIF + + factor_h = ((Pi*(alphah+3.)*(alphah+1.)*(alphah+1.))/6.)**(1./3.) + factor_hl = ((Pi*(alphahl+3.)*(alphahl+1.)*(alphahl+1.))/6.)**(1./3.) + ! ! jy = 1 ! working on a 2d slab !! VERY IMPORTANT: SET jgs = jy @@ -4852,29 +5889,155 @@ SUBROUTINE calc_eff_radius & DO ix = 1,nx ! ixcol rho0(mgs) = dn(ix,jy,kz) - DO il = lc,ls + IF ( present( an ) ) THEN + DO il = lc,lhab qx(mgs,il) = max(an(ix,jy,kz,il), 0.0) cx(mgs,il) = max(an(ix,jy,kz,ln(il)), 0.0) ENDDO + ELSE + qx(mgs,:) = 0.0 + cx(mgs,:) = 0.0 + IF ( present(qcw) ) qx(mgs,lc) = qcw(ix,kz) + IF ( present(qci) ) qx(mgs,li) = qci(ix,kz) + IF ( present(qsw) ) qx(mgs,ls) = qsw(ix,kz) + IF ( present(qrw) ) qx(mgs,lr) = qrw(ix,kz) + IF ( present(ccw) ) cx(mgs,lc) = ccw(ix,kz)*rho0(mgs) + IF ( present(cci) ) cx(mgs,li) = cci(ix,kz)*rho0(mgs) + IF ( present(csw) ) cx(mgs,ls) = csw(ix,kz)*rho0(mgs) + IF ( present(crw) ) cx(mgs,lr) = crw(ix,kz)*rho0(mgs) - IF ( qx(mgs,lc) > qxmin(lc) ) THEN + ENDIF + + IF ( present( t1 ) .and. qx(mgs,lc) > qxmin(lc) .and. cx(mgs,lc) > cxmin ) THEN ! Lambda for cloud droplets lam_c = ((cx(mgs,lc)*(Pi/6.)*xdn0(lc)*Gamc1)/(qx(mgs,lc)*rho0(mgs)*Gamc2))**(1./3.) t1(ix,jy,kz) = 0.5*factor_c/lam_c ENDIF - IF ( qx(mgs,li) > qxmin(li) ) THEN + IF ( present( t2 ) .and. qx(mgs,li) > qxmin(li) .and. cx(mgs,li) > cxmin ) THEN ! Lambda for cloud ice lam_i = ((cx(mgs,li)*(Pi/6.)*xdn0(li)*Gami1)/(qx(mgs,li)*rho0(mgs)*Gami2))**(1./3.) t2(ix,jy,kz) = 0.5*factor_i/lam_i ENDIF - IF ( qx(mgs,ls) > qxmin(ls) ) THEN + IF ( present( t3 ) .and. qx(mgs,ls) > qxmin(ls) .and. cx(mgs,ls) > cxmin ) THEN ! Lambda for snow lam_s = ((cx(mgs,ls)*(Pi/6.)*xdn0(ls)*Gams1)/(qx(mgs,ls)*rho0(mgs)*Gams2))**(1./3.) t3(ix,jy,kz) = 0.5*factor_s/lam_s ENDIF + IF ( present( t4 ) .and.( ( present(qrw) .and. present(crw) ) .or. flag_t4 ) ) THEN + IF ( qx(mgs,lr) > Max(1.e-8,qxmin(lr)) .and. cx(mgs,lr) > cxmin ) THEN + IF ( imurain == 1 ) THEN ! gamma-diameter +! Lambda for rain + lam_r = factor_r *((xdn0(lr)*cx(mgs,lr))/(qx(mgs,lr)*rho0(mgs)))**(1./3.) + t4(ix,jy,kz) = 0.5*(alphar+3.)/lam_r + ELSE ! gamma-volume +! Lambda for rain + lam_r = ((cx(mgs,lr)*(Pi/6.)*xdn0(lr)*Gamr1)/(qx(mgs,lr)*rho0(mgs)*Gamr2))**(1./3.) + t4(ix,jy,kz) = 0.5*factor_r/lam_r + ENDIF + ENDIF + ENDIF + + IF ( present(t5) .and. flag_t5 ) THEN + + ! first: case when hail is off + + IF ( lhl < 1 .or. flag_t6 ) THEN + ! graupel only + IF ( qx(mgs,lh) > Max(1.e-8,qxmin(lh)) ) THEN + ! Lambda for graupel + hwdn = xdn0(lh) + IF ( lvh > 1 ) THEN ! variable density + IF ( an(ix,jy,kz,lvh) > 1.e-30 ) THEN + hwdn = rho0(mgs)*qx(mgs,lh)/an(ix,jy,kz,lvh) + ENDIF + ENDIF + + lam_h = factor_h *((hwdn*cx(mgs,lh))/(qx(mgs,lh)*rho0(mgs)))**(1./3.) + t5(ix,jy,kz) = 0.5*(alphah+3.)/lam_h + ENDIF + + ELSE ! have hail, too, but do not have t6 array + + IF ( qx(mgs,lh) > Max(1.e-8,qxmin(lh)) .and. qx(mgs,lhl) < Max(1.e-8,qxmin(lhl)) ) THEN +! Lambda for graupel + hwdn = xdn0(lh) + IF ( lvh > 1 ) THEN ! variable density + IF ( an(ix,jy,kz,lvh) > 1.e-30 ) THEN + hwdn = rho0(mgs)*qx(mgs,lh)/an(ix,jy,kz,lvh) + ENDIF + ENDIF + + lam_h = factor_h *((hwdn*cx(mgs,lh))/(qx(mgs,lh)*rho0(mgs)))**(1./3.) + t5(ix,jy,kz) = 0.5*(alphah+3.)/lam_h + + ELSEIF ( qx(mgs,lh) < Max(1.e-8,qxmin(lh)) .and. qx(mgs,lhl) > Max(1.e-8,qxmin(lhl)) ) THEN +! Lambda for hail + hldn = xdn0(lhl) + IF ( lvhl > 1 ) THEN ! variable density + IF ( an(ix,jy,kz,lvhl) > 1.e-30 ) THEN + hldn = rho0(mgs)*qx(mgs,lhl)/an(ix,jy,kz,lvhl) + ENDIF + ENDIF + + lam_hl = factor_hl *((hldn*cx(mgs,lhl))/(qx(mgs,lhl)*rho0(mgs)))**(1./3.) + t5(ix,jy,kz) = 0.5*(alphahl+3.)/lam_hl + + ELSEIF ( qx(mgs,lh) > Max(1.e-8,qxmin(lh)) .and. qx(mgs,lhl) > Max(1.e-8,qxmin(lhl)) ) THEN +! r_eff graupel and hail combined + + hldn = xdn0(lhl) + IF ( lvhl > 1 ) THEN ! variable density + IF ( an(ix,jy,kz,lvhl) > 1.e-30 ) THEN + hldn = rho0(mgs)*qx(mgs,lhl)/an(ix,jy,kz,lvhl) + ENDIF + ENDIF + + hwdn = xdn0(lh) + IF ( lvh > 1 ) THEN ! variable density + IF ( an(ix,jy,kz,lvh) > 1.e-30 ) THEN + hwdn = rho0(mgs)*qx(mgs,lh)/an(ix,jy,kz,lvh) + ENDIF + ENDIF + + lam_h = factor_h *((hwdn*cx(mgs,lh))/(qx(mgs,lh)*rho0(mgs)))**(1./3.) + lam_hl = factor_hl *((hldn*cx(mgs,lhl))/(qx(mgs,lhl)*rho0(mgs)))**(1./3.) + + numh = cx(mgs,lh)*(alphah+3.)*(alphah+2.)*(alphah+1.)/lam_h**3 + numhl = cx(mgs,lhl)*(alphahl+3.)*(alphahl+2.)*(alphahl+1.)/lam_hl**3 + + denomh = cx(mgs,lh)*(alphah+2.)*(alphah+1.)/lam_h**2 + denomhl = cx(mgs,lhl)*(alphahl+2.)*(alphahl+1.)/lam_hl**2 + + t5(ix,jy,kz) = 0.5*(numh + numhl)/(denomh + denomhl) + + + ENDIF ! no t6 array + + ENDIF ! lhl + + ENDIF ! flag_t5 + + IF ( present(t6) .and. flag_t6 .and. lhl > 1 ) THEN + + IF ( qx(mgs,lhl) > Max(1.e-8,qxmin(lhl)) ) THEN +! Lambda for hail + hldn = xdn0(lhl) + IF ( lvhl > 1 ) THEN ! variable density + IF ( an(ix,jy,kz,lvhl) > 1.e-30 ) THEN + hldn = rho0(mgs)*qx(mgs,lhl)/an(ix,jy,kz,lvhl) + ENDIF + ENDIF + + lam_hl = factor_hl *((hldn*cx(mgs,lhl))/(qx(mgs,lhl)*rho0(mgs)))**(1./3.) + t6(ix,jy,kz) = 0.5*(alphahl+3.)/lam_hl + + ENDIF + + ENDIF ! t6 + ENDDO ! ix ENDDO ! kz @@ -6172,7 +7335,9 @@ SUBROUTINE setvtz(ngscnt,qx,qxmin,qxw,cx,rho0,rhovt,xdia,cno,cnostmp, & ! DO il = lc,lhab ! IF ( il .ne. lr ) THEN DO mgs = 1,ngscnt - vtxbar(mgs,lc,2) = vtxbar(mgs,lc,1) + IF ( ildo == 0 .or. ildo == lc ) THEN + vtxbar(mgs,lc,2) = vtxbar(mgs,lc,1) + ENDIF IF ( li .gt. 1 ) THEN ! vtxbar(mgs,li,2) = rhovt(mgs)*49420.*1.25447*xdia(mgs,li,1)**(1.415) ! n-wgt (Ferrier 94) ! vtxbar(mgs,li,2) = vtxbar(mgs,li,1) @@ -6242,6 +7407,9 @@ SUBROUTINE setvtz(ngscnt,qx,qxmin,qxw,cx,rho0,rhovt,xdia,cno,cnostmp, & ELSEIF ( icdxhl .eq. 6 ) THEN ! Milbrandt and Morrison (2013) aax = axx(mgs,lhl) bbx = bxx(mgs,lhl) + ELSEIF ( icdxhl <= 0 ) THEN ! + aax = ax(lhl) + bbx = bx(lhl) ENDIF ENDIF ! } @@ -6285,7 +7453,6 @@ SUBROUTINE setvtz(ngscnt,qx,qxmin,qxw,cx,rho0,rhovt,xdia,cno,cnostmp, & aax = ax(il) vtxbar(mgs,il,2) = rhovt(mgs)*ax(il)*(xdia(mgs,il,1)**bx(il)*x)/y ENDIF - ! vtxbar(mgs,il,2) = & ! & rhovt(mgs)*(xdn(mgs,il)/400.)*(75.715*xdia(mgs,il,1)**0.6* & ! & x)/y @@ -6307,7 +7474,7 @@ SUBROUTINE setvtz(ngscnt,qx,qxmin,qxw,cx,rho0,rhovt,xdia,cno,cnostmp, & vtxbar(mgs,il,3) = rhovt(mgs)* & & (aax*(xdia(mgs,il,1) )**bbx * & & x)/y -! & Gamma(7.0 + alpha(mgs,il) + bbx))/Gamma(7. + alpha(mgs,il)) +! & Gamma(7.0 + alpha(mgs,il) + bbx)/Gamma(7. + alpha(mgs,il)) IF ( .not. (vtxbar(mgs,il,1) > -1. .and. vtxbar(mgs,il,1) < 200. ) .or. & .not. (vtxbar(mgs,il,3) > -1. .and. vtxbar(mgs,il,3) < 200. ) ) THEN write(0,*) 'Setvtz: problem with vtxbar1/3: ',il,vtxbar(mgs,il,1),vtxbar(mgs,il,3),aax,bbx,x,y @@ -6549,7 +7716,11 @@ subroutine ziegfall1d(nx,ny,nz,nor,norz,na,dtp,jgs,ixcol, & real vtmax real xvbarmax - + + real, parameter :: c1r=19.0, c2r=0.6, c3r=1.8, c4r=17.0 ! rain + real, parameter :: c1h=5.5, c2h=0.7, c3h=4.5, c4h=8.5 ! Graupel + real, parameter :: c1hl=3.7, c2hl=0.3, c3hl=9.0, c4hl=6.5, c5hl=1.0, c6hl=6.5 ! Hail + integer l1, l2 double precision :: dpt1, dpt2 @@ -6825,10 +7996,466 @@ subroutine ziegfall1d(nx,ny,nz,nor,norz,na,dtp,jgs,ixcol, & ELSEIF ( imurain == 3 ) THEN alpha(:,lr) = xnu(lr) ENDIF + + + IF ( ipconc == 5 .and. imydiagalpha > 0 ) THEN + DO mgs = 1,ngscnt + IF ( qx(mgs,lr) .gt. qxmin(lr) .and. cx(mgs,lr) > cxmin ) THEN + xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xdn(mgs,lr)*cx(mgs,lr)) ! + xdia(mgs,lr,3) = (xv(mgs,lr)*6.0*cwc1)**(1./3.) + alpha(mgs,lr) = Min(alphamax, c1r*tanh(c2r*(xdia(mgs,lr,3)*1000. - c3r)) + c4r) + ENDIF + IF ( qx(mgs,lh) .gt. qxmin(lh) .and. cx(mgs,lh) > cxmin ) THEN + xv(mgs,lh) = rho0(mgs)*qx(mgs,lh)/(xdn(mgs,lh)*cx(mgs,lh)) ! + xdia(mgs,lh,3) = (xv(mgs,lh)*6.*piinv)**(1./3.) ! mwfac*xdia(mgs,lh,1) ! (xv(mgs,lh)*cwc0*6.0)**(1./3.) + alpha(mgs,lh) = Min(alphamax, c1h*tanh(c2h*(xdia(mgs,lh,3)*1000. - c3h)) + c4h) + ENDIF +! alpha(:,lr) = 0. ! 10. +! alpha(:,lh) = 0. ! 10. + IF ( lhl > 0 ) THEN + IF ( qx(mgs,lhl) .gt. qxmin(lhl) .and. cx(mgs,lhl) > cxmin ) THEN + xv(mgs,lhl) = rho0(mgs)*qx(mgs,lhl)/(xdn(mgs,lhl)*cx(mgs,lhl)) ! + xdia(mgs,lhl,3) = (xv(mgs,lhl)*6.*piinv)**(1./3.) + IF ( xdia(mgs,lhl,3) < 0.008 ) THEN + alpha(mgs,lhl) = Min(alphamax, c1hl*tanh(c2hl*(xdia(mgs,lhl,3)*1000. - c3hl)) + c4hl) + ELSE + alpha(mgs,lhl) = Min(alphamax, c5hl*xdia(mgs,lhl,3)*1000. + c6hl) + ENDIF + ENDIF + ENDIF + ENDDO + ENDIF + + +! +! Set 6th moments +! + IF ( ipconc .ge. 6 .or. lzr > 1) THEN + + zx(:,:) = 0.0 + +! DO il = lr,lhab + DO il = l1,l2 + + IF ( lz(il) .ge. 1 ) THEN + + DO mgs = 1,ngscnt + zx(mgs,il) = Max(an(igs(mgs),jy,kgs(mgs),lz(il)), 0.0) + ENDDO + + + ENDIF + + ENDDO + + ENDIF + + + + +! Find shape parameter rain + + + IF ( lz(lr) > 1 .and. (ildo == 0 .or. ildo == lr ) .and. imurain == 3 ) THEN ! { RAIN SHAPE PARAM + il = lr + DO mgs = 1,ngscnt + + IF ( iresetmoments == 1 .or. iresetmoments == il ) THEN +! IF ( .false. .and. zx(mgs,lr) <= zxmin ) THEN + IF ( zx(mgs,lr) <= zxmin ) THEN + qx(mgs,lr) = 0.0 + cx(mgs,lr) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),lr) + an(igs(mgs),jgs,kgs(mgs),lr) = qx(mgs,lr) + an(igs(mgs),jgs,kgs(mgs),ln(lr)) = cx(mgs,lr) +! ELSEIF ( zx(mgs,lr) <= 0.0 .and. cx(mgs,lr) > 0.0 .and. qx(mgs,il) .gt. qxmin(il)) THEN +! write(91,*) 'ZF: overdepletion of Zr: z,c,q = ',zx(mgs,il),cx(mgs,il),qx(mgs,il) + ELSEIF ( cx(mgs,lr) <= cxmin ) THEN + zx(mgs,lr) = 0.0 + qx(mgs,lr) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),lr) + an(igs(mgs),jgs,kgs(mgs),lr) = qx(mgs,lr) + an(igs(mgs),jgs,kgs(mgs),lz(lr)) = zx(mgs,lr) + ENDIF + ENDIF + + + + IF ( qx(mgs,lr) .gt. qxmin(lr) ) THEN + + xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xdn(mgs,lr)*Max(1.0e-11,cx(mgs,lr))) + IF ( xv(mgs,lr) .gt. xvmx(lr) ) THEN +! tmp = cx(mgs,lr) +! xv(mgs,lr) = xvmx(lr) +! cx(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xvmx(lr)*xdn(mgs,lr)) +! an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) +! IF ( tmp < cx(mgs,il) ) THEN ! breakup +! g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) +!! zx(mgs,lr) = zx(mgs,lr) + g1*(rho0(mgs)/(1000.))**2*( (qx(mgs,il)/tmp)**2 * (tmp-cx(mgs,il)) ) +!! an(igs(mgs),jgs,kgs(mgs),lz(lr)) = zx(mgs,lr) +! ENDIF + ELSEIF ( xv(mgs,lr) .lt. xvmn(lr) ) THEN + xv(mgs,lr) = xvmn(lr) + cx(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xvmn(lr)*xdn(mgs,lr)) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ENDIF + + IF ( zx(mgs,il) > 0.0 .and. cx(mgs,il) <= 0.0 ) THEN +! have mass and reflectivity but no concentration, so set concentration, using default alpha + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + z = zx(mgs,il) + qr = qx(mgs,il) + + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z*1000.*1000) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) > cxmin ) THEN +! have mass and concentration but no reflectivity, so set reflectivity, using default alpha + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + chw = cx(mgs,il) + qr = qx(mgs,il) + +! xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(1000.*Max(1.0e-9,cx(mgs,lr))) +! vr = xv(mgs,lr) + +! z = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/((alpha(mgs,lr)+1.0)*pi**2) +! zx(mgs,il) = z +! an(igs(mgs),jy,kgs(mgs),lz(il)) = z + + zx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(xdn(mgs,lr)**2*chw) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= 0.0 ) THEN +! How did this happen? + ! set values according to dBZ of -10, or Z = 0.1 +! write(91,*) 'alpha = ',alpha(mgs,il) + IF ( qx(mgs,il) < 1.e-8 ) THEN + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + ELSE +! 0.1 = 1.e18*0.224*an(ix,jy,kz,lzh)*(hwdn/rwdn)**2 + zx(mgs,il) = 1.e-19/0.224*(xdn0(lr)/xdn0(il))**2 + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + z = zx(mgs,il) + qr = qx(mgs,il) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z*1000.*1000) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ENDIF + ENDIF + + IF ( zx(mgs,lr) > 0.0 ) THEN + xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(1000.*Max(1.0e-9,cx(mgs,lr))) + vr = xv(mgs,lr) +! z = 36.*(alpha(kz)+2.0)*a(ix,jy,kz,lnr)*vr**2/((alpha(kz)+1.0)*pi**2) + qr = qx(mgs,lr) + nrx = cx(mgs,lr) + z = zx(mgs,lr) + +! xv = (db(1,kz)*a(1,1,kz,lr))**2/(a(1,1,kz,lnr)) +! rd = z*(pi/6.*1000.)**2/xv + +! determine shape parameter alpha by iteration + IF ( z .gt. 0.0 ) THEN +! alpha(mgs,lr) = 3. + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. + DO i = 1,20 +! IF ( 100.*Abs(alp - alpha(mgs,lr))/Abs(alpha(mgs,lr)) .lt. 1. ) EXIT + IF ( Abs(alp - alpha(mgs,lr)) .lt. 0.01 ) EXIT + alpha(mgs,lr) = Max( rnumin, Min( rnumax, alp ) ) + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. +! write(0,*) 'i,alp = ',i,alp + alp = Max( rnumin, Min( rnumax, alp ) ) + ENDDO +! write(0,*) 'kz, alp, alpha(kz) = ',kz,alp,alpha(mgs,lr),qr*1000,z*1.e18,vr,nrx + + +! check for artificial breakup (rain larger than allowed max size) + IF ( xv(mgs,il) .gt. xvmx(il) ) THEN + tmp = cx(mgs,il) + xv(mgs,il) = Min( xvmx(il), Max( xvmn(il),xv(mgs,il) ) ) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il)) + IF ( tmp < cx(mgs,il) ) THEN ! breakup + + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + zx(mgs,il) = zx(mgs,il) + g1*(rho0(mgs)/xdn(mgs,il))**2*( (qx(mgs,il)/tmp)**2 * (tmp-cx(mgs,il)) ) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + vr = xv(mgs,lr) + qr = qx(mgs,lr) + nrx = cx(mgs,lr) + z = zx(mgs,lr) + + +! determine shape parameter alpha by iteration + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. + DO i = 1,20 + IF ( Abs(alp - alpha(mgs,lr)) .lt. 0.01 ) EXIT + alpha(mgs,lr) = Max( rnumin, Min( rnumax, alp ) ) + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. + alp = Max( rnumin, Min( rnumax, alp ) ) + ENDDO + + + ENDIF + ENDIF + +! +! Check whether the shape parameter is at or less than the minimum, and if it is, reset the +! concentration or reflectivity to match (prevents reflectivity from being out of balance with Q and N) +! +! IF ( alpha(mgs,il) <= rnumin .or. alp == rnumin .or. alp == rnumax ) THEN + IF ( .true. .and. (alpha(mgs,il) <= rnumin .or. alp == rnumin .or. alp == rnumax) ) THEN + + IF ( rescale_high_alpha .and. alp >= rnumax - 0.01 ) THEN ! reset c at high alpha to prevent growth in Z + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z*(1./(xdn(mgs,il)))**2 + an(igs(mgs),jy,kgs(mgs),ln(il)) = cx(mgs,il) + + ELSEIF ( rescale_low_alphar .and. alp <= rnumin ) THEN + + z = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/((alpha(mgs,lr)+1.0)*pi**2) + zx(mgs,il) = z + an(igs(mgs),jy,kgs(mgs),lz(il)) = z + + ENDIF + ENDIF + + ENDIF + ENDIF + + ELSE + + zx(mgs,lr) = 0.0 + cx(mgs,lr) = 0.0 + an(igs(mgs),jgs,kgs(mgs),ln(lr)) = cx(mgs,lr) + an(igs(mgs),jgs,kgs(mgs),lz(lr)) = zx(mgs,lr) + + ENDIF + + ENDDO + ENDIF ! } + + + IF ( ipconc .ge. 6 ) THEN + +! Find shape parameters for graupel,hail + + DO il = lr,lhab + + IF ( lz(il) .gt. 1 .and. (ildo == 0 .or. ildo == il ) .and. ( .not. ( il == lr .and. imurain == 3 )) ) THEN + + DO mgs = 1,ngscnt + + IF ( iresetmoments == 1 .or. iresetmoments == il .or. iresetmoments == -1 ) THEN + IF ( zx(mgs,il) <= zxmin ) THEN ! .and. qx(mgs,il) > 0.05e-3 ) THEN + qx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ELSEIF ( iresetmoments == -1 .and. qx(mgs,il) < qxmin(il) ) THEN + zx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + ELSEIF ( cx(mgs,il) <= cxmin .and. iresetmoments /= -1 ) THEN ! .and. qx(mgs,il) > 0.05e-3 ) THEN +!! write(91,*) 'cx=0; qx,zx = ',1000.*qx(mgs,il),1.e18*zx(mgs,il) + zx(mgs,il) = 0.0 + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + ENDIF + ENDIF + IF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= cxmin ) THEN + zx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + ENDIF + + IF ( qx(mgs,il) .gt. qxmin(il) ) THEN + + xv(mgs,il) = rho0(mgs)*qx(mgs,il)/(xdn(mgs,il)*Max(1.0e-9,cx(mgs,il))) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + + IF ( xv(mgs,il) .lt. xvmn(il) ) THEN +! tmp = cx(mgs,il) + xv(mgs,il) = Min( xvmx(il), Max( xvmn(il),xv(mgs,il) ) ) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il)) +! IF ( tmp < cx(mgs,il) ) THEN ! breakup +! g1 = 36.*(6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & +! & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))*pi**2) +! zx(mgs,il) = zx(mgs,il) + g1*(rho0(mgs)/xdn(mgs,il))**2*( (qx(mgs,il)/tmp)**2 * (tmp-cx(mgs,il)) ) +! an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) +! +! ENDIF + ENDIF + + IF ( zx(mgs,il) > 0.0 .and. cx(mgs,il) <= 0.0 ) THEN +! have mass and reflectivity but no concentration, so set concentration, using default alpha + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + z = zx(mgs,il) + qr = qx(mgs,il) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(6*qr)**2/(z*(pi*xdn(mgs,il))**2) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) > cxmin ) THEN +! have mass and concentration but no reflectivity, so set reflectivity, using default alpha + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + chw = cx(mgs,il) + qr = qx(mgs,il) +! zx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/chw + zx(mgs,il) = Min(zxmin*1.1, g1*dn(igs(mgs),jy,kgs(mgs))**2*(6*qr)**2/(chw*(pi*xdn(mgs,il))**2) ) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= 0.0 ) THEN +! How did this happen? +! write(91,*) 'ziegfall: something screwy with moments: il = ',il +! write(91,*) 'q,n,z = ', 1.e3*qx(mgs,il),cx(mgs,il),zx(mgs,il) +! write(91,*) 'alpha = ',alpha(mgs,il) + + IF ( qx(mgs,il) < 1.e-8 ) THEN + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + ELSE +! write(0,*) 'alpha = ',alpha(mgs,il) + ! set values according to dBZ of -10 +! 0.1 = 1.e18*0.224*an(ix,jy,kz,lzh)*(hwdn/rwdn)**2 + zx(mgs,il) = 1.e-19/0.224*(xdn0(lr)/xdn0(il))**2 + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + z = zx(mgs,il) + qr = qx(mgs,il) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(6*qr)**2/(z*(pi*xdn(mgs,il))**2) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ENDIF + ENDIF + ENDIF + + IF ( qx(mgs,il) .gt. qxmin(il) .and. cx(mgs,il) .gt. cxmin ) THEN + chw = cx(mgs,il) + qr = qx(mgs,il) + z = zx(mgs,il) + + IF ( zx(mgs,il) .gt. 0. ) THEN + +! rd = z*(pi/6.*1000.)**2*chw/(0.224*(dn(igs(mgs),jy,kgs(mgs))*qr)**2) + rd = z*(pi/6.*xdn(mgs,il))**2*chw/((dn(igs(mgs),jy,kgs(mgs))*qr)**2) + + alp = (6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rd) - 1.0 + DO i = 1,10 + IF ( Abs(alp - alpha(mgs,il)) .lt. 0.01 ) EXIT + alpha(mgs,il) = Max( alphamin, Min( alphamax, alp ) ) + alp = (6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rd) - 1.0 +! write(0,*) 'i,alp = ',i,alp + alp = Max( alphamin, Min( alphamax, alp ) ) + ENDDO + + + +! check for artificial breakup (graupel/hail larger than allowed max size) + + IF ( imaxdiaopt == 1 ) THEN + xvbarmax = xvmx(il) + ELSEIF ( imaxdiaopt == 2 ) THEN ! test against maximum mass diameter + xvbarmax = xvmx(il) /((3. + alpha(mgs,il))**3/((3. + alpha(mgs,il))*(2. + alpha(mgs,il))*(1. + alpha(mgs,il)))) + ELSEIF ( imaxdiaopt == 3 ) THEN ! test against mass-weighted diameter + xvbarmax = xvmx(il) /((4. + alpha(mgs,il))**3/((3. + alpha(mgs,il))*(2. + alpha(mgs,il))*(1. + alpha(mgs,il)))) + ENDIF + + IF ( xv(mgs,il) .gt. xvbarmax ) THEN + tmp = cx(mgs,il) + xv(mgs,il) = Min( xvbarmax, Max( xvmn(il),xv(mgs,il) ) ) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il)) + IF ( tmp < cx(mgs,il) ) THEN ! breakup + g1 = 36.*(6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))*pi**2) + zx(mgs,il) = zx(mgs,il) + g1*(rho0(mgs)/xdn(mgs,il))**2*( (qx(mgs,il)/tmp)**2 * (tmp-cx(mgs,il)) ) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + chw = cx(mgs,il) + qr = qx(mgs,il) + z = zx(mgs,il) + + rd = z*(pi/6.*xdn(mgs,il))**2*chw/((rho0(mgs)*qr)**2) + alp = (6.0+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rd) - 1.0 + DO i = 1,10 + IF ( Abs(alp - alpha(mgs,il)) .lt. 0.01 ) EXIT + alpha(mgs,il) = Max( alphamin, Min( alphamax, alp ) ) + alp = (6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rd) - 1.0 + alp = Max( alphamin, Min( alphamax, alp ) ) + ENDDO + + + ENDIF + ENDIF + +! +! Check whether the shape parameter is at or less than the minimum, and if it is, reset the +! concentration or reflectivity to match (prevents reflectivity from being out of balance with Q and N) +! + IF ( (rescale_low_alpha .or. rescale_high_alpha ) .and. & + & ( alpha(mgs,il) <= alphamin .or. alp == alphamin .or. alp == alphamax ) ) THEN + + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + IF ( rescale_high_alpha .and. alp >= alphamax - 0.01 ) THEN ! reset c at high alpha to prevent growth in Z + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z*(6./(pi*xdn(mgs,il)))**2 + an(igs(mgs),jy,kgs(mgs),ln(il)) = cx(mgs,il) + + ELSEIF ( rescale_low_alpha .and. alp <= alphamin .and. .not. (il == lh .and. icvhl2h > 0 ) ) THEN + +!! z1 = g1*dn(igs(mgs),jy,kgs(mgs))**2*( 0.224*qr)*qr/chw + z1 = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/chw + z = z1*(6./(pi*xdn(mgs,il)))**2 + zx(mgs,il) = z + an(igs(mgs),jy,kgs(mgs),lz(il)) = z + ENDIF + ENDIF + ELSE + ENDIF + ENDIF + ENDDO ! mgs + + ENDIF ! lz(il) .gt. 1 + + ENDDO ! il + +! CALL cld_cpu('Z-MOMENT-ZFAll') + + ENDIF + IF ( lzhl > 1 ) THEN + IF ( lhl .gt. 1 ) THEN + + ENDIF + ENDIF @@ -6860,6 +8487,19 @@ subroutine ziegfall1d(nx,ny,nz,nor,norz,na,dtp,jgs,ixcol, & & ( vtxbar(mgs,il,1) .gt. vtxbar(mgs,il,3) .and. vtxbar(mgs,il,3) > 0.0) ) THEN +! IF ( qx(mgs,il) > 1.e-4 .and. & +! & .not. ( il == lr .and. 1.e3*xdia(mgs,il,3) > 5.0 ) ) THEN +! write(0,*) 'infdo,mgs = ',infdo,lzr,mgs +! write(0,*) 'Moment problem with vtxbar for il at i,j,k = ',il,igs(mgs),jy,kgs(mgs) +! write(0,*) 'nx,ny,nz,ng = ',nx,ny,nz,nor +! write(0,*) 'cwmasn,cwmasx = ',cwmasn,cwmasx +! write(0,*) 'vt1,2,3 = ',vtxbar(mgs,il,1),vtxbar(mgs,il,2),vtxbar(mgs,il,3) +! write(0,*) 'q,n,d = ', 1.e3*qx(mgs,il),cx(mgs,il),1.e3*xdia(mgs,il,3) +! IF ( il .ge. lr .and. lz(il) > 1 ) write(0,*) 'z = ', zx(mgs,il) +! IF ( il .ge. lg .or. il == lr ) THEN +! write(0,*) 'alpha = ',alpha(mgs,il) +! ENDIF +! ENDIF vtxbar(mgs,il,1) = Max( vtxbar(mgs,il,1), vtxbar(mgs,il,2) ) vtxbar(mgs,il,3) = Max( vtxbar(mgs,il,3), vtxbar(mgs,il,1) ) @@ -6870,6 +8510,18 @@ subroutine ziegfall1d(nx,ny,nz,nor,norz,na,dtp,jgs,ixcol, & IF ( vtxbar(mgs,il,1) .gt. vtmax .or. vtxbar(mgs,il,2) .gt. vtmax .or. & & vtxbar(mgs,il,3) .gt. vtmax ) THEN +! IF ( ndebugzf >= 0 .and. 1.e3*qx(mgs,il) > 0.1 ) THEN +! write(0,*) 'infdo = ',infdo +! write(0,*) 'Problem with vtxbar for il at i,j,k = ',il,igs(mgs),jy,kgs(mgs) +! write(0,*) 'nx,ny,nz,ng = ',nx,ny,nz,nor +! write(0,*) 'cwmasn,cwmasx = ',cwmasn,cwmasx +! write(0,*) 'vt1,2,3 = ',vtxbar(mgs,il,1),vtxbar(mgs,il,2),vtxbar(mgs,il,3) +! write(0,*) 'q,n,d = ', 1.e3*qx(mgs,il),cx(mgs,il),1.e3*xdia(mgs,il,3) +! IF ( il .ge. lr .and. lz(il) > 1 ) write(0,*) 'z = ', zx(mgs,il) +! IF ( il .ge. lg ) THEN +! write(0,*) 'alpha = ',alpha(mgs,il) +! ENDIF +! ENDIF vtxbar(mgs,il,1) = Min(vtmax,vtxbar(mgs,il,1) ) vtxbar(mgs,il,2) = Min(vtmax,vtxbar(mgs,il,2) ) vtxbar(mgs,il,3) = Min(vtmax,vtxbar(mgs,il,3) ) @@ -7379,6 +9031,8 @@ subroutine radardd02(nx,ny,nz,nor,na,an,temk, & IF ( ipconc .le. 2 ) THEN gtmp(ix,kz) = dadr*an(ix,jy,kz,lr)**(0.25) dtmp(ix,kz) = zrc*gtmp(ix,kz)**7 + ELSEIF ( lzr .gt. 1 ) THEN + dtmp(ix,kz) = 1e18*an(ix,jy,kz,lzr) ELSEIF ( an(ix,jy,kz,lnr) .gt. 1.e-3 ) THEN IF ( imurain == 3 ) THEN vr = db(ix,jy,kz)*an(ix,jy,kz,lr)/(1000.*an(ix,jy,kz,lnr)) @@ -7571,7 +9225,7 @@ subroutine radardd02(nx,ny,nz,nor,na,an,temk, & ELSE ! new form using a mass relationship m = p d^2 (instead of d^3 -- Cox 1988 QJRMS) so that density depends on size ! p = 0.106214 for m = p v^(2/3) - dnsnow = 0.346159*sqrt(an(ix,jy,kz,lns)/(an(ix,jy,kz,ls)*db(ix,jy,kz)) ) + dnsnow = 0.0346159*sqrt(an(ix,jy,kz,lns)/(an(ix,jy,kz,ls)*db(ix,jy,kz)) ) IF ( .true. .or. dnsnow < 900. ) THEN gtmp(ix,kz) = 1.e18*323.3226* 0.106214**2*(ksq*an(ix,jy,kz,ls) + & & (1.-ksq)*qxw)*an(ix,jy,kz,ls)*db(ix,jy,kz)**2*gsnow73/ & @@ -7647,6 +9301,10 @@ subroutine radardd02(nx,ny,nz,nor,na,an,temk, & IF ( izieg .ge. 1 .and. ipconc .ge. 5 ) THEN ltest = .false. + IF ( lzh > 1 ) THEN + IF ( an(ix,jy,kz,lzh) > 0.0 .and. an(ix,jy,kz,lh) > qhmin .and. & + an(ix,jy,kz,lnh) >= cxmin ) ltest = .true. + ENDIF IF ( ltest .or. (an(ix,jy,kz,lh) .ge. qhmin .and. an(ix,jy,kz,lnh) .ge. cxmin )) THEN @@ -7692,6 +9350,9 @@ subroutine radardd02(nx,ny,nz,nor,na,an,temk, & ENDIF IF ( lzh .gt. 1 ) THEN + x = (0.224*qh + 0.776*qxw)/an(ix,jy,kz,lh) ! weighted average of dielectric const + dtmph = 1.e18*x*an(ix,jy,kz,lzh)*(hwdn/rwdn)**2 + dtmp(ix,kz) = dtmp(ix,kz) + dtmph ELSE g1 = (6.0 + alphah)*(5.0 + alphah)*(4.0 + alphah)/((3.0 + alphah)*(2.0 + alphah)*(1.0 + alphah)) ! zx = g1*(db(ix,jy,kz)*an(ix,jy,kz,lh))**2/chw @@ -7764,6 +9425,10 @@ subroutine radardd02(nx,ny,nz,nor,na,an,temk, & IF ( ipconc .ge. 5 ) THEN ltest = .false. + IF ( lzhl > 1 ) THEN + IF ( an(ix,jy,kz,lzhl) > 0.0 .and. an(ix,jy,kz,lhl) > qhlmin .and. & + an(ix,jy,kz,lnhl) > 0.0 ) ltest = .true. + ENDIF IF ( ltest .or. ( an(ix,jy,kz,lhl) .ge. qhlmin .and. an(ix,jy,kz,lnhl) .gt. 0.) ) THEN !{ chl = an(ix,jy,kz,lnhl) @@ -7787,6 +9452,9 @@ subroutine radardd02(nx,ny,nz,nor,na,an,temk, & ENDIF IF ( lzhl .gt. 1 ) THEN !{ + x = (0.224*an(ix,jy,kz,lhl) + 0.776*qxw)/an(ix,jy,kz,lhl) ! weighted average of dielectric const + dtmphl = 1.e18*x*an(ix,jy,kz,lzhl)*(hldn/rwdn)**2 + dtmp(ix,kz) = dtmp(ix,kz) + dtmphl ELSE !} g1 = (6.0 + alphahl)*(5.0 + alphahl)*(4.0 + alphahl)/((3.0 + alphahl)*(2.0 + alphahl)*(1.0 + alphahl)) @@ -7895,8 +9563,8 @@ subroutine radardd02(nx,ny,nz,nor,na,an,temk, & write(0,*) 'dtmpr = ',dtmpr write(0,*) 'gtmp = ',gtmp(ix,kz),dtmp(ix,kz) IF ( .not. (dbz(ix,jy,kz) .gt. -100 .and. dbz(ix,jy,kz) .lt. 200 ) ) THEN - write(0,*) 'dbz out of bounds! STOP!' -! STOP + write(0,*) 'dbz out of bounds!' +! STOP ENDIF ENDIF @@ -7937,6 +9605,8 @@ END subroutine radardd02 ! ##################################################################### ! ! Subroutine for explicit cloud condensation and droplet nucleation +! +! 11/30/2022: Fixed droplet evaporation heating term for CM1 eqtset=2 (was only doing eqtset=1) ! SUBROUTINE NUCOND & & (nx,ny,nz,na,jyslab & @@ -7945,6 +9615,7 @@ SUBROUTINE NUCOND & & ,t0,t9 & & ,an,dn,p2 & & ,pn,w & + & ,ngs & & ,axtra,io_flag & & ,ssfilt,t00,t77,flag_qndrop & & ) @@ -8003,6 +9674,7 @@ SUBROUTINE NUCOND & logical :: io_flag real :: dv + real :: ccnefactwo, sstmp, cn1, cnuctmp ! ! declarations microphysics and for gather/scatter @@ -8011,7 +9683,6 @@ SUBROUTINE NUCOND & real, parameter :: cwmas20 = 1000.*0.523599*(2.*20.e-6)**3 ! mass of 20-micron radius droplet, for sat. adj. integer nxmpb,nzmpb,nxz integer mgs,ngs,numgs,inumgs - parameter (ngs=500) integer ngscnt,igs(ngs),kgs(ngs) integer kgsp(ngs),kgsm(ngs) integer nsvcnt @@ -8030,6 +9701,7 @@ SUBROUTINE NUCOND & real ccnc(ngs), ccna(ngs), cnuc(ngs), cwnccn(ngs) + real :: ccnc_nu(ngs), ccnc_ac(ngs), ccnc_co(ngs) real ccncuf(ngs) real sscb ! 'cloud base' SS threshold parameter ( sscb = 2.0 ) @@ -8042,7 +9714,7 @@ SUBROUTINE NUCOND & integer ifilt ! =1 to filter ssat, =0 to set ssfilt=ssat parameter ( ifilt = 0 ) real temp1,temp2 ! ,ssold - real :: ssmax(ngs) = 0.0 ! maximum SS experienced by a parcel + real :: ssmax(ngs) ! maximum SS experienced by a parcel real ssmx real dnnet,dqnet ! real cnu,rnu,snu,cinu @@ -8160,14 +9832,12 @@ SUBROUTINE NUCOND & real :: cvm,cpm,rmm - real, parameter :: rovcp = rd/cp real, parameter :: cpv = 1885.0 ! specific heat of water vapor at constant pressure integer :: kstag integer :: count - ! ------------------------------------------------------------------------------- itile = nxi jtile = ny @@ -8181,6 +9851,7 @@ SUBROUTINE NUCOND & kzbeg = 1 nzbeg = 1 + IF ( ac_opt > 0 ) ccnefactwo = (1.63e-3/(cck * beta(3./2., cck/2.)))**(1.0/(cck + 2.0)) f5 = 237.3 * 17.27 * 2.5e6 / cp ! combined constants for rain condensation (Soong and Ogura 73) jy = 1 @@ -8264,7 +9935,7 @@ SUBROUTINE NUCOND & if ( temg(1) .lt. tfr ) then end if ! - if ( (temg(1) .gt. tfrh .or. an(ix,jy,kz,lv)/qvs(1) > maxsupersat ) .and. & + if ( (temg(1) .gt. tfrh .or. an(ix,jy,kz,lv)/qvs(1) > maxlowtempss ) .and. & & ( an(ix,jy,kz,lv) .gt. qss(1) .or. & & an(ix,jy,kz,lc) .gt. qxmin(lc) .or. & & ( an(ix,jy,kz,lr) .gt. qxmin(lr) .and. rcond == 2 ) & @@ -8291,6 +9962,7 @@ SUBROUTINE NUCOND & qx(:,:) = 0.0 cx(:,:) = 0.0 + zx(:,:) = 0.0 xv(:,:) = 0.0 xmas(:,:) = 0.0 @@ -8350,6 +10022,7 @@ SUBROUTINE NUCOND & ELSE ! equation set 2 in cm1 tmp = qx(mgs,li)+qx(mgs,ls)+qx(mgs,lh) IF ( lhl > 1 ) tmp = tmp + qx(mgs,lhl) + IF ( lf > 1 ) tmp = tmp + qx(mgs,lf) cvm = cv+cvv*qx(mgs,lv)+cpl*(qx(mgs,lc)+qx(mgs,lr)) & +cpigb*(tmp) cpm = cp+cpv*qx(mgs,lv)+cpl*(qx(mgs,lc)+qx(mgs,lr)) & @@ -8404,12 +10077,16 @@ SUBROUTINE NUCOND & ELSE ssmax(mgs) = 0.0 ENDIF - IF ( lccn .gt. 1 ) THEN - ccnc(mgs) = an(igs(mgs),jy,kgs(mgs),lccn) + IF ( lccn .gt. 1 .and. ac_opt == 0 ) THEN + IF ( lccnuf .gt. 1 .and. i_uf_or_ccn > 0 ) THEN + ccnc(mgs) = an(igs(mgs),jy,kgs(mgs),lccn) + an(igs(mgs),jy,kgs(mgs),lccnuf) + ELSE + ccnc(mgs) = an(igs(mgs),jy,kgs(mgs),lccn) + ENDIF ELSE ccnc(mgs) = cwnccn(mgs) ENDIF - IF ( lccnuf .gt. 1 ) THEN + IF ( lccnuf .gt. 1 .and. i_uf_or_ccn == 0 ) THEN ccncuf(mgs) = an(igs(mgs),jy,kgs(mgs),lccnuf) ELSE ccncuf(mgs) = 0.0 @@ -8464,8 +10141,239 @@ SUBROUTINE NUCOND & ventrxn(:) = ventrn +! Find shape parameter rain -! write(0,*) 'NUCOND: Set ssf variables, ssmxinit =',ssmxinit + IF ( lzr > 1 .and. rcond == 2 ) THEN ! { RAIN SHAPE PARAM + DO mgs = 1,ngscnt + zx(mgs,lr) = Max(an(igs(mgs),jy,kgs(mgs),lzr), 0.0) + ENDDO + +! CALL cld_cpu('Z-MOMENT-1r2') + il = lr + DO mgs = 1,ngscnt + + IF ( zx(mgs,il) <= zxmin ) THEN + qx(mgs,lv) = qx(mgs,lv) + qx(mgs,il) + qx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ELSEIF ( cx(mgs,il) <= 0.0 ) THEN + qx(mgs,lv) = qx(mgs,lv) + qx(mgs,il) + zx(mgs,il) = 0.0 + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + ENDIF + + IF ( qx(mgs,lr) .gt. qxmin(lr) ) THEN + + xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xdn(mgs,lr)*Max(1.0e-11,cx(mgs,lr))) + IF ( xv(mgs,lr) .gt. xvmx(lr) ) THEN + xv(mgs,lr) = xvmx(lr) + cx(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xvmx(lr)*xdn(mgs,lr)) + ELSEIF ( xv(mgs,lr) .lt. xvmn(lr) ) THEN + xv(mgs,lr) = xvmn(lr) + cx(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xvmn(lr)*xdn(mgs,lr)) + ENDIF + + IF ( zx(mgs,il) > 0.0 .and. cx(mgs,il) <= 0.0 ) THEN +! have mass and reflectivity but no concentration, so set concentration, using default alpha + IF ( imurain == 3 ) THEN + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + z1 = zx(mgs,il) + qr = qx(mgs,il) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z1*1000.*1000) + ELSE + g1 = 36.*(6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))*pi**2) + z1 = zx(mgs,il) + qr = qx(mgs,il) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z1*1000.*1000) + + ENDIF +! an(igs(mgs),jgs,kgs(mgs),ln(il)) = zx(mgs,il) + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) > 0.0 ) THEN +! have mass and concentration but no reflectivity, so set reflectivity, using default alpha + IF ( imurain == 3 ) THEN + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + chw = cx(mgs,il) + qr = qx(mgs,il) + zx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(chw*1000.*1000) + ELSE + g1 = 36.*(6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))*pi**2) + chw = cx(mgs,il) + qr = qx(mgs,il) + zx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(chw*1000.*1000) + + ENDIF + + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= 0.0 ) THEN +! How did this happen? + ! set values according to dBZ of -10, or Z = 0.1 +! 0.1 = 1.e18*0.224*an(ix,jy,kz,lzh)*(hwdn/rwdn)**2 + zx(mgs,il) = 1.e-19/0.224*(xdn0(lr)/xdn0(il))**2 + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + IF ( imurain == 3 ) THEN + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + z1 = zx(mgs,il) + qr = qx(mgs,il) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z1*1000.*1000) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ELSEIF ( imurain == 1 ) THEN + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + z1 = zx(mgs,il) + qr = qx(mgs,il) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(6*qr)**2/(z1*(pi*xdn(mgs,il))**2) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + + ENDIF + ENDIF + + IF ( zx(mgs,lr) > 0.0 ) THEN + vr = rho0(mgs)*qx(mgs,lr)/(1000.*cx(mgs,lr)) +! z1 = 36.*(alpha(kz)+2.0)*a(ix,jy,kz,lnr)*vr**2/((alpha(kz)+1.0)*pi**2) + qr = qx(mgs,lr) + nrx = cx(mgs,lr) + z1 = zx(mgs,lr) + +! xv = (db(1,kz)*a(1,1,kz,lr))**2/(a(1,1,kz,lnr)) +! rd = z1*(pi/6.*1000.)**2/xv + + +! determine shape parameter alpha by iteration + IF ( z1 .gt. 0.0 ) THEN + + IF ( imurain == 3 ) THEN + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z1*pi**2) - 1. +! write(0,*) 'kz, alp, alpha(kz) = ',kz,alp,alpha(kz),rd,z1,xv + DO i = 1,20 + IF ( Abs(alp - alpha(mgs,lr)) .lt. 0.01 ) EXIT + alpha(mgs,lr) = Max( rnumin, Min( rnumax, alp ) ) + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z1*pi**2) - 1. +! write(0,*) 'i,alp = ',i,alp + alp = Max( rnumin, Min( rnumax, alp ) ) + ENDDO + + ELSE ! imurain == 1 + g1 = 36.*(6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))*pi**2) + + rd1 = z1*(pi/6.*xdn(mgs,il))**2*nrx/(rho0(mgs)*qr)**2 + + alp = (6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rd1) - 1.0 + + DO i = 1,10 + IF ( Abs(alp - alpha(mgs,il)) .lt. 0.01 ) EXIT + alpha(mgs,il) = Max( alphamin, Min( alphamax, alp ) ) + + alp = (6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rd1) - 1.0 + + alp = Max( alphamin, Min( alphamax, alp ) ) + ENDDO + + + ENDIF +! ENDIF + +! +! Check whether the shape parameter is at or less than the minimum, and if it is, reset the +! concentration or reflectivity to match (prevents reflectivity from being out of balance with Q and N) +! + IF ( imurain == 3 ) THEN + IF ( .true. .and. (alpha(mgs,il) <= rnumin .or. alp == rnumin .or. alp == rnumax) ) THEN + + IF ( rescale_high_alpha .and. alp >= rnumax - 0.01 ) THEN ! reset c at high alpha to prevent growth in Z + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z1*(1./(xdn(mgs,il)))**2 + an(igs(mgs),jy,kgs(mgs),ln(il)) = cx(mgs,il) + + ELSEIF ( rescale_low_alphar .and. alp <= rnumin ) THEN + + z1 = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/((alpha(mgs,lr)+1.0)*pi**2) + zx(mgs,il) = z1 + ENDIF + ENDIF + + ELSEIF ( imurain == 1 ) THEN + + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + + IF ( (rescale_low_alpha .or. rescale_high_alpha ) .and. & + & ( alpha(mgs,il) <= alphamin .or. alp == alphamin .or. alp == alphamax ) ) THEN + + + + IF ( rescale_high_alpha .and. alp >= alphamax - 0.01 ) THEN ! reset c at high alpha to prevent growth in Z + cx(mgs,il) = g1*rho0(mgs)**2*(qr)*qr/zx(mgs,lr)*(6./(pi*xdn(mgs,il)))**2 + an(igs(mgs),jy,kgs(mgs),ln(il)) = cx(mgs,il) + + ELSEIF ( rescale_low_alpha .and. alp <= alphamin ) THEN ! alpha = alphamin, so reset Z to prevent growth in C + z1 = g1*rho0(mgs)**2*(qr)*qr/nrx + z2 = z1*(6./(pi*xdn(mgs,il)))**2 + zx(mgs,il) = z2 + an(igs(mgs),jy,kgs(mgs),lz(il)) = z2 + ENDIF + ENDIF ! imurain + + ENDIF ! z > 0 + + tmp = alpha(mgs,lr) + 4./3. + i = Int(dgami*(tmp)) + del = tmp - dgam*i + x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + + tmp = alpha(mgs,lr) + 1. + i = Int(dgami*(tmp)) + del = tmp - dgam*i + y = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + +! ventrx(mgs) = Gamma(alpha(mgs,lr) + 4./3.)/(alpha(mgs,lr) + 1.)**(1./3.)/Gamma(alpha(mgs,lr) + 1.) + ventrx(mgs) = x/(y*(alpha(mgs,lr) + 1.)**(1./3.)) + + IF ( imurain == 3 .and. izwisventr == 2 ) THEN + + tmp = alpha(mgs,lr) + 1.5 + br/6. + i = Int(dgami*(tmp)) + del = tmp - dgam*i + x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + +! ventrx(mgs) = Gamma(alpha(mgs,lr) + 1.5 + br/6.)/Gamma(alpha(mgs,lr) + 1.) + ventrxn(mgs) = x/(y*(alpha(mgs,lr) + 1.)**((1.+br)/6. + 1./3.)) + + ELSEIF ( imurain == 1 .and. iferwisventr == 2 ) THEN + + tmp = alpha(mgs,lr) + 2.5 + br/2. + i = Int(dgami*(tmp)) + del = tmp - dgam*i + x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + +! ventrx(mgs) = Gamma(alpha(mgs,lr) + 1.5 + br/6.)/Gamma(alpha(mgs,lr) + 1.) + ventrxn(mgs) = x/y + + + ENDIF + + + ENDIF + ENDIF + + ENDIF + + ENDDO +! CALL cld_cpu('Z-MOMENT-1r2') + ENDIF ! } + + +! write(0,*) 'NUCOND: Set ssf variables, ssmxinit =',ssmxinit ssmx = 0.0 DO mgs = 1,ngscnt @@ -8483,6 +10391,8 @@ SUBROUTINE NUCOND & ssfkp1(mgs) = ssfilt(igs(mgs),jgs,Min(nz-1,kgs(mgs)+1)) ssfkm1(mgs) = ssfilt(igs(mgs),jgs,Max(1,kgs(mgs)-1)) +! IF ( wvel(mgs) /= 0.0 ) write(0,*) 'mgs,wvel1,ssf = ',mgs,wvel(mgs),ssf(mgs) + ENDDO @@ -8492,7 +10402,7 @@ SUBROUTINE NUCOND & ! cloud water variables ! - if ( ndebug .gt. 0 )write(0,*) 'ICEZVD_DR: Set cloud water variables' + if ( ndebug .gt. 0 ) write(0,*) 'ICEZVD_DR: Set cloud water variables' do mgs = 1,ngscnt xv(mgs,lc) = 0.0 @@ -8596,7 +10506,9 @@ SUBROUTINE NUCOND & DO mgs=1,ngscnt dcloud = 0.0 - IF ( temg(mgs) .le. tfrh .and. qx(mgs,lv)/qvs(mgs) < maxsupersat ) THEN + ! Skip points at low temperature if SS stays less than 1.08, + ! otherwise allow nucleation at low temp (will freeze at next time step) + IF ( temg(mgs) .le. tfrh .and. qx(mgs,lv)/qvs(mgs) < maxlowtempss ) THEN CYCLE ENDIF @@ -8614,23 +10526,22 @@ SUBROUTINE NUCOND & QEVAP= Min( qx(mgs,lc), R1*(qss(mgs)-qvap(mgs)) ) - IF ( qx(mgs,lc) .LT. QEVAP ) THEN ! GO TO 63 + IF ( qx(mgs,lc) <= QEVAP ) THEN ! GO TO 63 qwvp(mgs) = qwvp(mgs) + qx(mgs,lc) - thetap(mgs) = thetap(mgs) - felv(mgs)*qx(mgs,lc)/(cp*pi0(mgs)) + thetap(mgs) = thetap(mgs) - felvcp(mgs)*qx(mgs,lc)/(pi0(mgs)) IF ( io_flag .and. nxtra > 1 ) THEN axtra(igs(mgs),jy,kgs(mgs),1) = -qx(mgs,lc)/dtp ENDIF qx(mgs,lc) = 0. IF ( restoreccn ) THEN - IF ( irenuc <= 2 ) THEN - IF ( .not. invertccn ) THEN - ccnc(mgs) = Max( ccnc(mgs), Min( qccn*rho0(mgs), ccnc(mgs) + cx(mgs,lc) ) ) - ELSE - ccnc(mgs) = ccnc(mgs) + cx(mgs,lc) - ENDIF - ENDIF - IF ( lccna > 1 ) THEN - ccna(mgs) = ccna(mgs) - cx(mgs,lc) + IF ( lccna > 1 ) THEN + ccna(mgs) = ccna(mgs) - restoreccnfrac*cx(mgs,lc) + ELSEIF ( irenuc <= 2 ) THEN + IF ( .not. invertccn ) THEN + ccnc(mgs) = Max( ccnc(mgs), Min( qccn*rho0(mgs), ccnc(mgs) + restoreccnfrac*cx(mgs,lc) ) ) + ELSE + ccnc(mgs) = ccnc(mgs) + restoreccnfrac*cx(mgs,lc) + ENDIF ENDIF ENDIF cx(mgs,lc) = 0. @@ -8640,39 +10551,37 @@ SUBROUTINE NUCOND & qx(mgs,lc) = qx(mgs,lc) - QEVAP IF ( qx(mgs,lc) .le. 0. ) THEN IF ( restoreccn ) THEN - IF ( irenuc <= 2 ) THEN + IF ( lccna > 1 ) THEN + ccna(mgs) = ccna(mgs) - restoreccnfrac*cx(mgs,lc) + ELSEIF ( irenuc <= 2 ) THEN ! ccnc(mgs) = Max( ccnc(mgs), Min( qccn*rho0(mgs), ccnc(mgs) + cx(mgs,lc) ) ) ! ccnc(mgs) = ccnc(mgs) + cx(mgs,lc) IF ( .not. invertccn ) THEN - ccnc(mgs) = Max( ccnc(mgs), Min( qccn*rho0(mgs), ccnc(mgs) + cx(mgs,lc) ) ) + ccnc(mgs) = Max( ccnc(mgs), Min( qccn*rho0(mgs), ccnc(mgs) + restoreccnfrac*cx(mgs,lc) ) ) ELSE - ccnc(mgs) = ccnc(mgs) + cx(mgs,lc) + ccnc(mgs) = ccnc(mgs) + restoreccnfrac*cx(mgs,lc) ENDIF ENDIF - IF ( lccna > 1 ) THEN - ccna(mgs) = ccna(mgs) - cx(mgs,lc) - ENDIF ENDIF cx(mgs,lc) = 0. ELSE tmp = 0.9*QEVAP*cx(mgs,lc)/qctmp ! let droplets get smaller but also remove some. A factor of 1.0 would maintain same size IF ( restoreccn ) THEN - IF ( irenuc <= 2 ) THEN + IF ( lccna > 1 ) THEN + ccna(mgs) = ccna(mgs) - restoreccnfrac*tmp + ELSEIF ( irenuc <= 2 ) THEN ! ccnc(mgs) = Max( ccnc(mgs), Min( qccn*rho0(mgs), ccnc(mgs) + tmp ) ) ! ccnc(mgs) = ccnc(mgs) + tmp IF ( .not. invertccn ) THEN - ccnc(mgs) = Max( ccnc(mgs), Min( qccn*rho0(mgs), ccnc(mgs) + tmp ) ) + ccnc(mgs) = Max( ccnc(mgs), Min( qccn*rho0(mgs), ccnc(mgs) + restoreccnfrac*tmp ) ) ELSE - ccnc(mgs) = ccnc(mgs) + tmp + ccnc(mgs) = ccnc(mgs) + restoreccnfrac*tmp ENDIF ENDIF - IF ( lccna > 1 ) THEN - ccna(mgs) = ccna(mgs) - tmp - ENDIF ENDIF cx(mgs,lc) = cx(mgs,lc) - tmp ENDIF - thetap(mgs) = thetap(mgs) - felv(mgs)*QEVAP/(CP*pi0(mgs)) + thetap(mgs) = thetap(mgs) - felvcp(mgs)*QEVAP/(pi0(mgs)) IF ( io_flag .and. nxtra > 1 ) THEN axtra(igs(mgs),jy,kgs(mgs),1) = -QEVAP/dtp ENDIF @@ -8954,6 +10863,19 @@ SUBROUTINE NUCOND & !! & dx*dy*dz3d(igs(mgs),jy,kgs(mgs)) + IF ( lzr > 1 .and. rcond == 2 .and. qx(mgs,lr) .gt. qxmin(lr) & + & .and. cx(mgs,lr) .gt. 1.e-9 ) THEN + tmp = qx(mgs,lr)/cx(mgs,lr) + IF ( imurain == 3 ) THEN + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + ELSE + g1 = 36.*(6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))*pi**2) + + ENDIF + zx(mgs,lr) = zx(mgs,lr) + g1*(rho0(mgs)/(xdn(mgs,lr)))**2*( 2.*( tmp ) * dqr ) + ENDIF + theta(mgs) = thetap(mgs) + theta0(mgs) temg(mgs) = theta(mgs)*f1 ltemq = (temg(mgs)-163.15)/fqsat+1.5 @@ -8995,7 +10917,8 @@ SUBROUTINE NUCOND & ! IF ( ssf(mgs) > ssmx .and. ssf(mgs) < 5.0 .and. ccnc(mgs) > 0.1*cwnccn(mgs) ) THEN ! this one works ! IF ( ssf(mgs) > ssmx .and. ssf(mgs) < 20.0 ) THEN ! test -- fails ! IF ( ssf(mgs) > ssmx .and. ssf(mgs) < 20.0 .and. ccnc(mgs) > 0.1*cwnccn(mgs)) THEN ! test -- is OK - IF ( ssf(mgs) > ssmx .and. ssf(mgs) < 20.0 .and. ccnc(mgs) > 0.05*cwnccn(mgs)) THEN ! test + IF ( ssf(mgs) > ssmx .and. ssf(mgs) < 20.0 .and. & + ( ccnc(mgs) > 0.05*cwnccn(mgs) .or. ( ac_opt > 0 .and. ccnc_ac(mgs) - cx(mgs,lc) > 0.0 ) ) ) THEN ! test ! IF ( ssf(mgs) > ssmx ) THEN ! original condition CALL QVEXCESS(ngs,mgs,qwvp,qv0,qx(1,lc),pres,thetap,theta0,dcloud, & & pi0,tabqvs,nqsat,fqsat,cbw,fcqv1,felvcp,ssmx,pk,ngscnt) @@ -9006,7 +10929,7 @@ SUBROUTINE NUCOND & ELSE dcloud = 0.0 ENDIF - + thetap(mgs) = thetap(mgs) + felvcp(mgs)*DCLOUD/(pi0(mgs)) qwvp(mgs) = qwvp(mgs) - DCLOUD qx(mgs,lc) = qx(mgs,lc) + DCLOUD @@ -9031,11 +10954,16 @@ SUBROUTINE NUCOND & IF ( .not. flag_qndrop ) THEN ! { do not calculate number of droplets if using wrf-chem + IF ( ac_opt == 0 ) THEN + cnuctmp = cnuc(mgs) + ELSE + cnuctmp = ccnc_ac(mgs) + ENDIF ! IF ( ssmax(mgs) .lt. sscb .and. qx(mgs,lc) .gt. qxmin(lc)) THEN IF ( dcloud .gt. qxmin(lc) .and. wvel(mgs) > 0.0) THEN ! CN(mgs) = CCNE*wvel(mgs)**cnexp ! *Min(1.0,1./dtp) ! 0.3465 - CN(mgs) = CCNE0*cnuc(mgs)**(2./(2.+cck))*wvel(mgs)**cnexp ! *Min(1.0,1./dtp) ! 0.3465 + CN(mgs) = CCNE0*cnuctmp**(2./(2.+cck))*wvel(mgs)**cnexp ! *Min(1.0,1./dtp) ! 0.3465 IF ( ny .le. 2 .and. cn(mgs) .gt. 0.0 & & .and. ncdebug .ge. 1 ) THEN write(iunit,*) 'CN: ',cn(mgs)*1.e-6, cx(mgs,lc)*1.e-6, qx(mgs,lc)*1.e3, & @@ -9057,12 +10985,16 @@ SUBROUTINE NUCOND & ENDIF IF ( cn(mgs) .gt. 0.0 ) THEN - IF ( cn(mgs) .gt. ccnc(mgs) ) THEN - cn(mgs) = ccnc(mgs) -! ccnc(mgs) = 0.0 + IF ( ac_opt == 0 ) THEN + IF ( cn(mgs) .gt. ccnc(mgs) ) THEN + cn(mgs) = ccnc(mgs) +! ccnc(mgs) = 0.0 + ENDIF + ELSE + cn(mgs) = Min( cn(mgs), ccnc_ac(mgs) ) ENDIF ! cx(mgs,lc) = cx(mgs,lc) + cn(mgs) - IF ( irenuc <= 2 ) ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) + IF ( irenuc <= 2 .and. lccna < 1 ) ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) ccna(mgs) = ccna(mgs) + cn(mgs) ENDIF @@ -9108,7 +11040,8 @@ SUBROUTINE NUCOND & DSSDZ=0. r2dzm=0.50/dz3d(igs(mgs),jy,kgs(mgs)) - IF ( irenuc >= 0 .and. .not. flag_qndrop) THEN ! turn off nucleation when flag_qndrop (using WRF-CHEM for activation) + + IF ( irenuc >= 0 .and. ac_opt == 0 .and. .not. flag_qndrop ) THEN ! turn off nucleation when flag_qndrop (using WRF-CHEM for activation) IF ( irenuc < 2 ) THEN !{ @@ -9185,6 +11118,7 @@ SUBROUTINE NUCOND & ! nucleation CN(mgs) = Min(cn(mgs), ccnc(mgs)) cn(mgs) = Min(cn(mgs), 0.5*dqc/cwmasn) ! limit the nucleation mass to half of the condensation mass + CN(mgs) = Min( CN(mgs), Max(0.0, (cnuc(mgs) - ccna(mgs) )) ) IF ( .false. .and. ny <= 2 ) THEN write(0,*) 'i,k, cwmasn = ',igs(mgs),kgs(mgs),cwmasn @@ -9212,8 +11146,136 @@ SUBROUTINE NUCOND & cx(mgs,lc) = cx(mgs,lc) + cn(mgs) - ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) + IF ( lccna < 1 ) ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) + + ELSEIF ( irenuc == 3 ) THEN !} { + ! Phillips Donner Garner 2007 +! if (ndebug .gt. 0) write(0,*) 'ICEZVD_DR: Cloud reNucleation, wvel = ',wvel(mgs) +! CN(mgs) = cwccn*Min(ssf(mgs),ssfcut)**cck + +! Need to calculate new ssf since condensation has happened: + temp1 = (theta0(mgs)+thetap(mgs))*pk(mgs) ! t77(ix,jy,kz) + ltemq = Int( (temp1-163.15)/fqsat+1.5 ) + ltemq = Min( nqsat, Max(1,ltemq) ) + + c1= pqs(mgs)*tabqvs(ltemq) + + ssf(mgs) = 0.0 + IF ( c1 > 0. ) THEN + ssf(mgs) = 100.*(qx(mgs,lv)/c1 - 1.0) ! from "new" values + ENDIF + CN(mgs) = cnuc(mgs)*Min(1.0, (ssf(mgs))**cck ) ! + + CN(mgs) = Max( 0.0, CN(mgs) - ccna(mgs) ) ! this was from + ! Philips, Donner et al. 2007, but results in too much limitation of + ! nucleation + CN(mgs) = Min(cn(mgs), ccnc(mgs)) + cn(mgs) = Min(cn(mgs), 0.5*dqc/cwmasn) ! limit the nucleation mass to half of the condensation mass + + cx(mgs,lc) = cx(mgs,lc) + cn(mgs) + + ! 6/13/2016: Phillips et al. appears not to decrement CCN, but only increments CCNa. + ! This would allow an initially non-homogeneous (vertically, e.g.) initial value of CCN/rho_air + ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) + + ELSEIF ( irenuc == 4 ) THEN !} { + ! modification of Phillips Donner Garner 2007 +! if (ndebug .gt. 0) write(0,*) 'ICEZVD_DR: Cloud reNucleation, wvel = ',wvel(mgs) +! CN(mgs) = CCNE0*cnuc(mgs)**(2./(2.+cck))*Max(0.0,wvel(mgs))**cnexp +! cn(mgs) = Min( cn(mgs), cnuc(mgs) ) +! Need to calculate new ssf since condensation has happened: + temp1 = (theta0(mgs)+thetap(mgs))*pk(mgs) ! t77(ix,jy,kz) + ltemq = Int( (temp1-163.15)/fqsat+1.5 ) + ltemq = Min( nqsat, Max(1,ltemq) ) + + c1= pqs(mgs)*tabqvs(ltemq) + IF ( c1 > 0. ) THEN + ssf(mgs) = Max(0.0, 100.*((qv0(mgs) + qwvp(mgs))/c1 - 1.0) ) ! from "new" values + ELSE + ssf(mgs) = 0.0 + ENDIF + CN(mgs) = cnuc(mgs)*Min(ssf2kmax, ssf(mgs)**cck) ! this allows cn(mgs) > cnuc(mgs) + + CN(mgs) = Max( 0.0, CN(mgs) - ccna(mgs) ) ! this was from + ! Philips, Donner et al. 2007, but results in too much limitation of + ! nucleation +! CN(mgs) = Min(cn(mgs), ccnc(mgs)) + cn(mgs) = Min(cn(mgs), 0.5*dqc/cwmasn) ! limit the nucleation mass to half of the condensation mass + + IF ( cn(mgs) > 0.0 ) THEN + cx(mgs,lc) = cx(mgs,lc) + cn(mgs) + ! ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) + + dcrit = 2.0*2.5e-7 + + dcloud = 1000.*dcrit**3*Pi/6.*cn(mgs) + qx(mgs,lc) = qx(mgs,lc) + DCLOUD + thetap(mgs) = thetap(mgs) + felvcp(mgs)*DCLOUD/(pi0(mgs)) + qwvp(mgs) = qwvp(mgs) - DCLOUD + ENDIF + ! 6/13/2016: Phillips et al. appears not to decrement CCN, but only increments CCNa. + ! This would allow an initially non-homogeneous (vertically, e.g.) initial value of CCN/rho_air +! ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) + + + + ELSEIF ( irenuc == 6 ) THEN !} { + + ! simple Twomey scheme but limit activation to try to do most activation near cloud base, but keep some CCN available for renuclation +! if (ndebug .gt. 0) write(0,*) 'ICEZVD_DR: Cloud reNucleation, wvel = ',wvel(mgs) + cn(mgs) = 0.0 +! IF ( ccna(mgs) < 0.7*cnuc(mgs) .and. ccnc(mgs) > 0.69*cnuc(mgs) - ccna(mgs)) THEN ! here, assume we are near cloud base and use Twomey formulation + IF ( ccna(mgs) < 0.7*cnuc(mgs) ) THEN ! here, assume we are near cloud base and use Twomey formulation + CN(mgs) = Min( 0.9*cnuc(mgs), CCNE0*cnuc(mgs)**(2./(2.+cck))*Max(0.0,wvel(mgs))**cnexp )! *Min(1.0,1./dtp) ! 0.3465 +! IF ( cn(mgs) + ccna(mgs) > 0.71*cnuc ) THEN + ! prevent this branch from activating more than 70% of CCN + CN(mgs) = Min( CN(mgs), Max(0.0, (0.7*cnuc(mgs) - ccna(mgs) )) ) +! CN(mgs) = Min( CN(mgs), Max(0.0, 0.71*ccnc(mgs) - ccna(mgs) ) ) + + ELSE + ! if a large fraction of CCN have been activated, then assume we are in the cloud interior and use local SSw as in Phillips et al. 2007. + + temp1 = (theta0(mgs)+thetap(mgs))*pk(mgs) ! t77(ix,jy,kz) +! t0(ix,jy,kz) = temp1 + ltemq = Int( (temp1-163.15)/fqsat+1.5 ) + ltemq = Min( nqsat, Max(1,ltemq) ) + +! c1 = t00(igs(mgs),jy,kgs(mgs))*tabqvs(ltemq) + c1= pqs(mgs)*tabqvs(ltemq) + IF ( c1 > 0. ) THEN + ssf(mgs) = Max(0.0, 100.*((qv0(mgs) + qwvp(mgs))/c1 - 1.0) ) ! from "new" values + ELSE + ssf(mgs) = 0.0 + ENDIF + +! CN(mgs) = cnuc(mgs)*Min(0.99, Min(ssf(mgs),ssfcut)**cck ) ! + CN(mgs) = cnuc(mgs)*Min(2.0, Max(0.0,ssf(mgs))**cck ) ! +! CN(mgs) = cnuc(mgs)*Min(ssf(mgs),ssfcut)**cck ! + + CN(mgs) = Min(0.01*cnuc(mgs), Max( 0.0, CN(mgs) - ccna(mgs) ) ) ! this was from +! cn(mgs) = 0.0 + ENDIF +! ccne = ccnefac*1.e6*(1.e-6*Abs(cwccn))**(2./(2.+cck)) +!!! CN(mgs) = Max( 0.0, CN(mgs) - ccna(mgs) ) ! this was from + ! Philips, Donner et al. 2007, but results in too much limitation of + ! nucleation +! CN(mgs) = Min(cn(mgs), ccnc(mgs)) +! cn(mgs) = Min(cn(mgs), 0.5*dqc/cwmasn) ! limit the nucleation mass to half of the condensation mass + + IF ( cn(mgs) > 0.0 ) THEN + cx(mgs,lc) = cx(mgs,lc) + cn(mgs) + + ! create some small droplets at minimum size (CP 2000), although it adds very little liquid + + dcrit = 2.0*2.5e-7 + + dcloud = 1000.*dcrit**3*Pi/6.*cn(mgs) + qx(mgs,lc) = qx(mgs,lc) + DCLOUD + thetap(mgs) = thetap(mgs) + felvcp(mgs)*DCLOUD/(pi0(mgs)) + qwvp(mgs) = qwvp(mgs) - DCLOUD + ! ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) + ENDIF ELSEIF ( irenuc == 5 ) THEN !} { ! modification of Phillips Donner Garner 2007 @@ -9271,17 +11333,22 @@ SUBROUTINE NUCOND & ! 6/13/2016: Phillips et al. appears not to decrement CCN, but only increments CCNa. ! This would allow an initially non-homogeneous (vertically, e.g.) initial value of CCN/rho_air ! ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) - ELSEIF ( irenuc == 7 ) THEN !} { + ELSEIF ( irenuc == 7 .or. irenuc == 17 ) THEN !} { ! simple Twomey scheme but limit activation to try to do most activation near cloud base, but keep some CCN available for renuclation ! if (ndebug .gt. 0) write(0,*) 'ICEZVD_DR: Cloud reNucleation, wvel = ',wvel(mgs) cn(mgs) = 0.0 + IF ( irenuc == 7 ) THEN + frac = 0.9 + ELSE + frac = 0.98 + ENDIF ! IF ( ccna(mgs) < 0.7*cnuc(mgs) .and. ccnc(mgs) > 0.69*cnuc(mgs) - ccna(mgs)) THEN ! here, assume we are near cloud base and use Twomey formulation - IF ( ccna(mgs) < 0.9*cnuc(mgs) ) THEN ! { here, assume we are near cloud base and use Twomey formulation - CN(mgs) = Min( 0.91*cnuc(mgs), CCNE0*cnuc(mgs)**(2./(2.+cck))*Max(0.0,wvel(mgs))**cnexp )! *Min(1.0,1./dtp) ! 0.3465 + IF ( ccna(mgs) < frac*cnuc(mgs) ) THEN ! { here, assume we are near cloud base and use Twomey formulation + CN(mgs) = Min( (frac+0.01)*cnuc(mgs), CCNE0*cnuc(mgs)**(2./(2.+cck))*Max(0.0,wvel(mgs))**cnexp )! *Min(1.0,1./dtp) ! 0.3465 ! IF ( cn(mgs) + ccna(mgs) > 0.71*cnuc ) THEN ! prevent this branch from activating more than 70% of CCN - CN(mgs) = Min( CN(mgs), Max(0.0, (0.9*cnuc(mgs) - ccna(mgs) )) ) + CN(mgs) = Min( CN(mgs), Max(0.0, (frac*cnuc(mgs) - ccna(mgs) )) ) ! CN(mgs) = Min( CN(mgs), Max(0.0, 0.71*ccnc(mgs) - ccna(mgs) ) ) ! write(0,*) '1: k,cn = ',kgs(mgs),cn(mgs),ssf(mgs) !! IF ( ccncuf(mgs) > 0.0 .and. cn(mgs) < 1.e-3 .and. ssmax(mgs) > 1.0 ) THEN @@ -9319,7 +11386,7 @@ SUBROUTINE NUCOND & ! write(0,*) 'k,cn = ',kgs(mgs),cn(mgs),ssf(mgs) ! write(0,*) 'ccn-ccna = ',cnuc(mgs) - ccna(mgs),ccnc(mgs) - ccna(mgs) ! IF ( ccncuf(mgs) > 0.0 .and. cn(mgs) < 1.e-3 .and. ssmax(mgs) > 1.0 ) THEN - IF ( ccncuf(mgs) > 0.0 .and. ssf(mgs) > ssmxuf .and. ssmax(mgs) > ssmxuf ) THEN + IF ( ccncuf(mgs) > 0.0 .and. ssf(mgs) > ssmxuf .and. ( ssmax(mgs) > ssmxuf .or. lss < 1 ) ) THEN CNuf(mgs) = Min( ccncuf(mgs), CCNE0*ccncuf(mgs)**(2./(2.+cck))*Max(0.0,wvel(mgs))**cnexp )! *Min(1.0,1./dtp) ! 0.3465 ! IF ( cnuf(mgs) >= 0.0 ) write(0,*) 'cnuf, k = ',cnuf(mgs),ccncuf(mgs),kgs(mgs) ENDIF @@ -9421,7 +11488,7 @@ SUBROUTINE NUCOND & IF ( cn(mgs) > 0.0 ) THEN cx(mgs,lc) = cx(mgs,lc) + cn(mgs) - ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) + ! ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) ! create some small droplets at minimum size (CP 2000), although it adds very little liquid @@ -9440,8 +11507,6 @@ SUBROUTINE NUCOND & ccna(mgs) = ccna(mgs) + cn(mgs) - - ENDIF ! irenuc >= 0 .and. .not. flag_qndrop IF( cx(mgs,lc) .GT. 0. .AND. qx(mgs,lc) .LE. qxmin(lc)) cx(mgs,lc)=0. @@ -9494,7 +11559,11 @@ SUBROUTINE NUCOND & ELSEIF ( imaxsupopt == 4 ) THEN cn(mgs) = Min( Max(ccnc(mgs),cwnccn(mgs)), rho0(mgs)*qvex/Max( cwmasn5, Max(cwmas20,xmas(mgs,lc)) ) ) ENDIF - ccnc(mgs) = Max( 0.0, ccnc(mgs) - cn(mgs) ) + IF ( lccna > 1 ) THEN + ccna(mgs) = ccna(mgs) + cn(mgs) + ELSE + ccnc(mgs) = Max( 0.0, ccnc(mgs) - cn(mgs) ) + ENDIF cx(mgs,lc) = cx(mgs,lc) + cn(mgs) ENDIF @@ -9599,15 +11668,21 @@ SUBROUTINE NUCOND & ! qx(mgs,lr) = an(igs(mgs),jy,kgs(mgs),lr) end if + IF ( lzr > 1 .and. rcond == 2 ) THEN + an(igs(mgs),jy,kgs(mgs),lzr) = zx(mgs,lr) + & + & min( an(igs(mgs),jy,kgs(mgs),lzr), 0.0 ) + ENDIF IF ( ipconc .ge. 2 ) THEN an(igs(mgs),jy,kgs(mgs),lnc) = Max(cx(mgs,lc) , 0.0) IF ( lss > 1 ) an(igs(mgs),jy,kgs(mgs),lss) = Max( 0.0, ssmax(mgs) ) - IF ( lccn .gt. 1 ) THEN - an(igs(mgs),jy,kgs(mgs),lccn) = Max(0.0, ccnc(mgs) ) + IF ( ac_opt == 0 ) THEN + IF ( lccn .gt. 1 .and. lccna .lt. 1 ) THEN + an(igs(mgs),jy,kgs(mgs),lccn) = Max(0.0, ccnc(mgs) ) + ENDIF ENDIF - IF ( lccnuf .gt. 1 ) THEN + IF ( lccnuf .gt. 1 .and. .not. ( lccna .gt. 1 .and. i_uf_or_ccn > 0 ) ) THEN an(igs(mgs),jy,kgs(mgs),lccnuf) = Max(0.0, ccncuf(mgs) ) ENDIF IF ( lccna .gt. 1 ) THEN @@ -9684,6 +11759,42 @@ SUBROUTINE NUCOND & IF ( lhl .gt. 1 ) THEN + IF ( lzhl .gt. 1 ) THEN + + an(ix,jy,kz,lzhl) = Max(0.0, an(ix,jy,kz,lzhl) ) + + IF ( an(ix,jy,kz,lhl) .ge. frac*qxmin(lhl) .and. rescale_low_alpha ) THEN ! check 6th moment + + IF ( an(ix,jy,kz,lnhl) .gt. 0.0 ) THEN + + IF ( lvhl .gt. 1 ) THEN + IF ( an(ix,jy,kz,lvhl) .gt. 0.0 ) THEN + hwdn = dn(ix,jy,kz)*an(ix,jy,kz,lhl)/an(ix,jy,kz,lvhl) + ELSE + hwdn = xdn0(lhl) + ENDIF + hwdn = Max( xdnmn(lhl), hwdn ) + ELSE + hwdn = xdn0(lhl) + ENDIF + + chw = an(ix,jy,kz,lnhl) + g1 = (6.0+alphamin)*(5.0+alphamin)*(4.0+alphamin)/ & + & ((3.0+alphamin)*(2.0+alphamin)*(1.0+alphamin)) + z1 = g1*dn(ix,jy,kz)**2*( an(ix,jy,kz,lhl) )*an(ix,jy,kz,lhl)/chw + z1 = z1*(6./(pi*hwdn))**2 + ELSE + z1 = 0.0 + ENDIF + + an(ix,jy,kz,lzhl) = Min( z1, an(ix,jy,kz,lzhl) ) + + IF ( an(ix,jy,kz,lnhl) .lt. 1.e-5 ) THEN +! an(ix,jy,kz,lzhl) = 0.9*an(ix,jy,kz,lzhl) + ENDIF + ENDIF + + ENDIF !lzhl if ( an(ix,jy,kz,lhl) .lt. frac*qxmin(lhl) .or. zerocx(lhl) ) then @@ -9703,6 +11814,10 @@ SUBROUTINE NUCOND & IF ( lhlw .gt. 1 ) THEN an(ix,jy,kz,lhlw) = 0.0 ENDIF + + IF ( lnhlf .gt. 1 ) THEN + an(ix,jy,kz,lnhlf) = 0.0 + ENDIF IF ( lzhl .gt. 1 ) THEN an(ix,jy,kz,lzhl) = 0.0 @@ -9780,13 +11895,49 @@ SUBROUTINE NUCOND & + IF ( lzh .gt. 1 ) THEN - if ( an(ix,jy,kz,lh) .lt. frac*qxmin(lh) .or. zerocx(lh) ) then - -! IF ( an(ix,jy,kz,lh) .gt. 0 ) THEN - an(ix,jy,kz,lv) = an(ix,jy,kz,lv) + an(ix,jy,kz,lh) - an(ix,jy,kz,lh) = 0.0 -! ENDIF + an(ix,jy,kz,lzh) = Max(0.0, an(ix,jy,kz,lzh) ) + + IF ( .false. .and. an(ix,jy,kz,lh) .ge. frac*qxmin(lh) .and. rescale_low_alpha ) THEN + + IF ( an(ix,jy,kz,lnh) .gt. 0.0 ) THEN + + IF ( lvh .gt. 1 ) THEN + IF ( an(ix,jy,kz,lvh) .gt. 0.0 ) THEN + hwdn = dn(ix,jy,kz)*an(ix,jy,kz,lh)/an(ix,jy,kz,lvh) + ELSE + hwdn = xdn0(lh) + ENDIF + hwdn = Max( xdnmn(lh), hwdn ) + ELSE + hwdn = xdn0(lh) + ENDIF + + chw = an(ix,jy,kz,lnh) + g1 = (6.0+alphamin)*(5.0+alphamin)*(4.0+alphamin)/ & + & ((3.0+alphamin)*(2.0+alphamin)*(1.0+alphamin)) + z1 = g1*dn(ix,jy,kz)**2*( an(ix,jy,kz,lh) )*an(ix,jy,kz,lh)/chw + z1 = z1*(6./(pi*hwdn))**2 + ELSE + z1 = 0.0 + ENDIF + + an(ix,jy,kz,lzh) = Min( z1, an(ix,jy,kz,lzh) ) + + IF ( an(ix,jy,kz,lnh) .lt. 1.e-5 ) THEN +! an(ix,jy,kz,lzh) = 0.9*an(ix,jy,kz,lzh) + ENDIF + ENDIF + + ENDIF + + if ( an(ix,jy,kz,lh) .lt. frac*qxmin(lh) .or. zerocx(lh) ) then + +! IF ( an(ix,jy,kz,lh) .gt. 0 ) THEN + an(ix,jy,kz,lv) = an(ix,jy,kz,lv) + an(ix,jy,kz,lh) + an(ix,jy,kz,lh) = 0.0 +! ENDIF IF ( ipconc .ge. 5 ) THEN ! .and. an(ix,jy,kz,lnh) .gt. 0.0 ) THEN an(ix,jy,kz,lnh) = 0.0 @@ -9799,6 +11950,10 @@ SUBROUTINE NUCOND & IF ( lhw .gt. 1 ) THEN an(ix,jy,kz,lhw) = 0.0 ENDIF + + IF ( lnhf .gt. 1 ) THEN + an(ix,jy,kz,lnhf) = 0.0 + ENDIF IF ( lzh .gt. 1 ) THEN an(ix,jy,kz,lzh) = 0.0 @@ -9936,6 +12091,9 @@ SUBROUTINE NUCOND & end if + IF ( lzr > 1 ) THEN + an(ix,jy,kz,lzr) = Max(0.0, an(ix,jy,kz,lzr) ) + ENDIF if ( an(ix,jy,kz,lr) .lt. frac*qxmin(lr) .or. zerocx(lr) & & ) then @@ -9946,6 +12104,10 @@ SUBROUTINE NUCOND & an(ix,jy,kz,lnr) = 0.0 ENDIF + IF ( lzr > 1 ) THEN + an(ix,jy,kz,lzr) = 0.0 + ENDIF + end if ! @@ -9998,18 +12160,25 @@ SUBROUTINE NUCOND & an(ix,jy,kz,lv) = an(ix,jy,kz,lv) + an(ix,jy,kz,lc) an(ix,jy,kz,lc)= 0.0 IF ( ipconc .ge. 2 ) THEN - IF ( lccn .gt. 1 ) THEN - an(ix,jy,kz,lccn) = & - & an(ix,jy,kz,lccn) + Max(0.0,an(ix,jy,kz,lnc)) + IF ( lccn .gt. 1 .or. ac_opt == 1 ) THEN + IF ( irenuc < 5 .and. lccna <= 1 ) THEN + IF ( ac_opt == 0 ) THEN + an(ix,jy,kz,lccn) = an(ix,jy,kz,lccn) + Max(0.0,an(ix,jy,kz,lnc)) + ENDIF + ELSEIF ( lccna > 1 ) THEN + an(ix,jy,kz,lccna) = Max( 0.0, an(ix,jy,kz,lccna) - Max(0.0,an(ix,jy,kz,lnc)) ) + ENDIF ENDIF an(ix,jy,kz,lnc) = 0.0 + IF ( lccn > 1 ) an(ix,jy,kz,lccn) = Max( 0.0, an(ix,jy,kz,lccn) ) - IF ( lccna > 0 ) THEN ! apply exponential decay to activated CCN to restore to environmental value + IF ( lccna > 0 .and. ac_opt == 0 ) THEN ! apply exponential decay to activated CCN to restore to environmental value + IF ( restoreccn ) THEN tmp = an(ix,jy,kz,li) + an(ix,jy,kz,ls) IF ( an(ix,jy,kz,lccna) > 1. .and. tmp < qxmin(li) ) an(ix,jy,kz,lccna) = an(ix,jy,kz,lccna)*Exp(-dtp/ccntimeconst) - - ELSEIF ( lccn > 1 .and. restoreccn ) THEN + ENDIF + ELSEIF ( lccn > 1 .and. restoreccn .and. ac_opt == 0 ) THEN ! in this case, we are treating the ccn field as ccna tmp = an(ix,jy,kz,li) + an(ix,jy,kz,ls) ! IF ( ny == 2 .and. ix == nx/2 ) THEN @@ -10071,8 +12240,9 @@ subroutine nssl_2mom_gs & ! & ln,ipc,lvol,lz,lliq, & & cdx, & & xdn0,tmp3d,tkediss & + & ,thproc,numproc,dx1,dy1,ngs & & ,timevtcalc,axtra,io_flag & - & , has_wetscav,rainprod2d, evapprod2d & + & , has_wetscav,rainprod2d, evapprod2d, alpha2d & & ,elec,its,ids,ide,jds,jde & & ) @@ -10153,9 +12323,17 @@ subroutine nssl_2mom_gs & integer :: my_rank = 0 integer, parameter :: myprock = 1, nprock = 1 logical, intent(in) :: has_wetscav + integer, intent(in) :: numproc + real, intent(inout) :: thproc(nz,numproc) + real, intent(in) :: dx1,dy1 real rainprod2d(-nor+1:nx+nor,-norz+ng1:nz+norz) real evapprod2d(-nor+1:nx+nor,-norz+ng1:nz+norz) + real alpha2d(-nor+1:nx+nor,-norz+ng1:nz+norz,3) + + real, parameter :: tfrdry = 243.15 + + logical lrescalelow(lc:lhab) real tkediss(-nor+1:nx+nor,-norz+ng1:nz+norz) real axtra(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz,nxtra) @@ -10192,7 +12370,6 @@ subroutine nssl_2mom_gs & logical, parameter :: usegamxinf3 = .false. ! real rar ! rime accretion rate as calculated from qxacw - ! a few vars for time-split fallout real vtmax integer n,ndfall @@ -10299,7 +12476,6 @@ subroutine nssl_2mom_gs & ! integer nxmpb,nzmpb,nxz integer jgs,mgs,ngs,numgs - parameter (ngs=500) !500) integer, parameter :: ngsz = 500 integer ntt parameter (ntt=300) @@ -10362,7 +12538,8 @@ subroutine nssl_2mom_gs & real ex1, ft, rhoinv(ngs) double precision ec0(ngs) - real ac1,bc, taus, c1,d1,e1,f1,p380,tmp,tmp1,tmp2,tmp3,tmp4,tmp5,temp3 ! , sstdy, super + real ac1,bc, taus, c1,d1,e1,f1,p380,tmp,tmp1,tmp2,tmp3,tmp4,tmp5,tmp6,temp3 ! , sstdy, super + real :: flim real dw,dwr double precision :: tmpz, tmpzmlt real ratio, delx, dely @@ -10443,7 +12620,7 @@ subroutine nssl_2mom_gs & real temgx(ngs),temcgx(ngs) real qvs(ngs),qis(ngs),qss(ngs),pqs(ngs) real elv(ngs),elf(ngs),els(ngs) - real tsqr(ngs),ssi(ngs),ssw(ngs) + real tsqr(ngs),ssi(ngs),ssw(ngs),ssi0(ngs) real qcwtmp(ngs),qtmp,qtot(ngs) real qcond(ngs) real ctmp, sctmp @@ -10458,6 +12635,7 @@ subroutine nssl_2mom_gs & parameter ( rwradmn = 50.e-6 ) real dh0 real dg0(ngs),df0(ngs) + real dhwet(ngs),dhlwet(ngs),dfwet(ngs) real clionpmx,clionnmx parameter (clionpmx=1.e9,clionnmx=1.e9) ! Takahashi 84 @@ -10465,7 +12643,7 @@ subroutine nssl_2mom_gs & ! other arrays real fwet1(ngs),fwet2(ngs) - real fmlt1(ngs),fmlt2(ngs) + real fmlt1(ngs),fmlt2(ngs),fmlt1e(ngs) real fvds(ngs),fvce(ngs),fiinit(ngs) real fvent(ngs),fraci(ngs),fracl(ngs) ! @@ -10483,13 +12661,13 @@ subroutine nssl_2mom_gs & real cvm,cpm,rmm - real, parameter :: rovcp = rd/cp real, parameter :: cpv = 1885.0 ! specific heat of water vapor at constant pressure ! real fcci(ngs), fcip(ngs) ! real :: sfm1(ngs),sfm2(ngs) real :: gfm1(ngs),gfm2(ngs) + real :: ffm1(ngs),ffm2(ngs) real :: hfm1(ngs),hfm2(ngs) logical :: wetsfc(ngs),wetsfchl(ngs),wetsfcf(ngs) @@ -10519,6 +12697,7 @@ subroutine nssl_2mom_gs & real :: vtxbar(ngs,lc:lhab,3) real :: xmas(ngs,lc:lhab) real :: xdn(ngs,lc:lhab) + real :: xdntmp(ngs,lc:lhab) real :: cdxgs(ngs,lc:lhab) real :: xdia(ngs,lc:lhab,3) real :: vtwtdia(ngs,lr:lhab) ! sweep-out volume weighted diameter @@ -10529,6 +12708,10 @@ subroutine nssl_2mom_gs & real :: alpha(ngs,lc:lhab) real :: dab0lh(ngs,lc:lhab,lc:lhab) real :: dab1lh(ngs,lc:lhab,lc:lhab) + real :: zx(ngs,lr:lhab) + real :: zxmxd(ngs,lr:lhab) + real :: g1x(ngs,lr:lhab) + real :: qsimxdep(ngs) ! max sublimation of qi+qs+qis real :: qsimxsub(ngs) ! max depositionof qi+qs+qis @@ -10544,6 +12727,7 @@ subroutine nssl_2mom_gs & real ventrxn(ngs) real g1shr, alphashr real g1mlr, alphamlr + real g1smlr, alphasmlr real massfacshr, massfacmlr real :: qhgt8mm ! ice mass greater than 8mm @@ -10556,6 +12740,8 @@ subroutine nssl_2mom_gs & real, parameter :: srasheym = 0.1389 ! slope fraction from Rasmussen and Heymsfield ! real swvent(ngs),hwvent(ngs),rwvent(ngs),hlvent(ngs),hwventy(ngs),hlventy(ngs),rwventz(ngs) + real hxventtmp + real hlventinc(ngs),hwventinc(ngs) integer, parameter :: ndiam = 10 integer :: numdiam real hwvent0(ndiam+4),hlvent0 ! 0 to d1 @@ -10643,6 +12829,7 @@ subroutine nssl_2mom_gs & real chlsbv(ngs), chldpv(ngs) real chlmlr(ngs), chlmlrr(ngs) + real chlfmlr(ngs) ! real chlmlrsave(ngs),chlsave(ngs),qhlsave(ngs) real chlshr(ngs), chlshrr(ngs) @@ -10668,15 +12855,15 @@ subroutine nssl_2mom_gs & real qrcnw(ngs), qwcnr(ngs) real zrcnw(ngs),zracr(ngs),zracw(ngs),zrcev(ngs) - real qracw(ngs) ! qwacr(ngs), real qiacw(ngs) !, qwaci(ngs) real qsacw(ngs) ! ,qwacs(ngs), real qhacw(ngs) ! qwach(ngs), - real :: qhlacw(ngs) ! + real :: qhlacw(ngs), qxacwtmp, qxacrtmp, qxacitmp, qxacstmp ! real vhacw(ngs), vsacw(ngs), vhlacw(ngs), vhlacr(ngs) + real qfcev(ngs) real qfmul1(ngs),cfmul1(ngs) ! real qsacws(ngs) @@ -10685,7 +12872,7 @@ subroutine nssl_2mom_gs & ! arrays for x-ac-r and r-ac-x; ! real qsacr(ngs),qracs(ngs) - real qhacr(ngs),qhacrmlr(ngs) ! ,qrach(ngs) + real qhacr(ngs),qhacrmlr(ngs),qhacwmlr(ngs) ! ,qrach(ngs) real vhacr(ngs), zhacr(ngs), zhacrf(ngs), zrach(ngs), zrachl(ngs) real qiacr(ngs),qraci(ngs) @@ -10693,7 +12880,7 @@ subroutine nssl_2mom_gs & real qracif(ngs),qiacrf(ngs),qiacrs(ngs),ciacrs(ngs) - real :: qhlacr(ngs),qhlacrmlr(ngs) + real :: qhlacr(ngs),qhlacrmlr(ngs), qhlacwmlr(ngs) real qsacrs(ngs) !,qracss(ngs) ! ! ice - ice interactions @@ -10739,7 +12926,8 @@ subroutine nssl_2mom_gs & real zfmlr(ngs), zfdsv(ngs), zfsbv(ngs), zhlcnf(ngs), zfshr(ngs), zfshrr(ngs) real zhmlrtmp,zhmlr0inf,zhlmlr0inf real zhmlrr(ngs),zhlmlrr(ngs),zhshrr(ngs),zhlshrr(ngs),zfmlrr(ngs) - real zsmlr(ngs), zsmlrr(ngs), zsshr(ngs) +! real zsmlr(ngs) + real zsmlrr(ngs), zsshr(ngs), zsshrr(ngs) real zhcns(ngs), zhcni(ngs) real zhwdn(ngs), zfwdn(ngs) ! change in Z due to density changes real zhldn(ngs) ! change in Z due to density changes @@ -10780,9 +12968,10 @@ subroutine nssl_2mom_gs & ! real :: qhldpv(ngs), qhlsbv(ngs) ! qhlcnv(ngs),qhlevv(ngs), real :: qhlmlr(ngs), qhldsv(ngs), qhlmlrsave(ngs) - real :: qhlwet(ngs), qhldry(ngs), qhlshr(ngs) + real :: qhlwet(ngs), qhldry(ngs), qhlshr(ngs), qxwettmp ! real :: qrfz(ngs),qsfz(ngs),qhfz(ngs),qhlfz(ngs) + real :: qffz(ngs) ! real qhdpv(ngs),qhsbv(ngs) ! qhcnv(ngs),qhevv(ngs), real qhmlr(ngs),qhdsv(ngs),qhcev(ngs),qhcndv(ngs),qhevv(ngs) @@ -10792,6 +12981,7 @@ subroutine nssl_2mom_gs & real qhshh(ngs) !accreted water that remains on graupel real qhmlh(ngs) !melt water that remains on graupel real qhfzh(ngs) !water that freezes on mixed-phase graupel + real qffzf(ngs) !water that freezes on mixed-phase FD real qhlfzhl(ngs) !water that freezes on mixed-phase hail real qhmlrlg(ngs),qhlmlrlg(ngs) ! melting from the larger diameters @@ -10843,6 +13033,7 @@ subroutine nssl_2mom_gs & real qrshr(ngs) real fsw(ngs),fhw(ngs),fhlw(ngs),ffw(ngs) !liquid water fractions real fswmax(ngs),fhwmax(ngs),fhlwmax(ngs) !liquid water fractions + real ffwmax(ngs) real qhcnf(ngs) real :: qhlcnh(ngs) real qhcngh(ngs),qhcngm(ngs),qhcngl(ngs) @@ -10856,7 +13047,7 @@ subroutine nssl_2mom_gs & real ehxr(ngs),ehlr(ngs),egmr(ngs) real eri(ngs),esi(ngs),egli(ngs),eghi(ngs),efi(ngs),efis(ngs) real ehxi(ngs),ehli(ngs),egmi(ngs),ehi(ngs),ehis(ngs),ehlis(ngs) - real ers(ngs),ess(ngs),egls(ngs),eghs(ngs),efs(ngs),ehs(ngs) + real ers(ngs),ess(ngs),egls(ngs),eghs(ngs),efs(ngs),ehs(ngs),ehsfac(ngs) real ehscnv(ngs) real ehxs(ngs),ehls(ngs),egms(ngs),egmip(ngs) @@ -10915,12 +13106,13 @@ subroutine nssl_2mom_gs & real pqgli(ngs),pqghi(ngs),pqfwi(ngs) real pqgmi(ngs),pqhli(ngs) ! ,pqhxi(ngs) real pqiri(ngs),pqipi(ngs) ! pqwai(ngs), - real pqlwsi(ngs),pqlwhi(ngs),pqlwhli(ngs) + real pqlwsi(ngs),pqlwhi(ngs),pqlwhli(ngs),pqlwfi(ngs) real pqlwlghi(ngs),pqlwlghli(ngs) real pqlwlghd(ngs),pqlwlghld(ngs) + real pvhwi(ngs), pvhwd(ngs) real pvfwi(ngs), pvfwd(ngs) @@ -10932,7 +13124,7 @@ subroutine nssl_2mom_gs & real pqgld(ngs),pqghd(ngs),pqfwd(ngs) real pqgmd(ngs),pqhld(ngs) ! ,pqhxd(ngs) real pqird(ngs),pqipd(ngs) ! pqwad(ngs), - real pqlwsd(ngs),pqlwhd(ngs),pqlwhld(ngs) + real pqlwsd(ngs),pqlwhd(ngs),pqlwhld(ngs),pqlwfd(ngs) ! ! real pqxii(ngs,nhab),pqxid(ngs,nhab) ! @@ -11036,8 +13228,8 @@ subroutine nssl_2mom_gs & real arg ! gamma is a function real erbnd1, fdgt1, costhe1 real qeps - real dyi2,dzi2,cp608,bta1,cnit,dragh,dnz00,pii - real qccrit,gf4br,gf4ds,gf4p5, gf3ds, gf1ds,gr + real dyi2,dzi2,bta1,cnit,dragh,dnz00,pii ! ,cp608 + real qccrit,gf4br,gf4ds,gf4p5, gf3ds, gf1ds real gf1palp(ngs) ! for storing Gamma[1.0 + alphar] @@ -11080,7 +13272,7 @@ subroutine nssl_2mom_gs & real frcrglgm, frcrglgh, frcrglfw, frcrglgl1 real frcgmrgl, frcgmrgm, frcgmrgh, frcgmrfw, frcgmrgm1 real frcrgmgl, frcrgmgm, frcrgmgh, frcrgmfw, frcrgmgm1 - real sum, qweps, gf2a, gf4a, dqldt, dqidt, dqdt + real total, qweps, gf2a, gf4a, dqldt, dqidt, dqdt real frcghrgl, frcghrgm, frcghrgh, frcghrfw, frcghrgh1, frcrghgl real frcrghgm, frcrghgh, frcrghfw, frcrghgh1 real a1,a2,a3,a4,a5,a6 @@ -11112,9 +13304,22 @@ subroutine nssl_2mom_gs & real :: term1,term2,term3,term4 real :: qaacw ! combined qsacw-qhacw for WSM6 variation + real :: cwchtmp + real, parameter :: c1r=19.0, c2r=0.6, c3r=1.8, c4r=17.0 ! rain + real, parameter :: c1h=5.5, c2h=0.7, c3h=4.5, c4h=8.5 ! Graupel + real, parameter :: c1hl=3.7, c2hl=0.3, c3hl=9.0, c4hl=6.5, c5hl=1.0, c6hl=6.5 ! Hail +! inline functions for Newton method + real :: galpha, dgalpha + real :: a_in + logical, parameter :: newton = .false. + + + galpha(a_in) = ((4. + a_in)*(5. + a_in)*(6. + a_in))/((1. + a_in)*(2. + a_in)*(3. + a_in)) + dgalpha(a_in) = (876. + 1260.*a_in + 621.*a_in**2 + 126.*a_in**3 + 9.*a_in**4)/ & + & (36. + 132.*a_in + 193.*a_in**2 + 144.*a_in**3 + 58.*a_in**4 + 12.*a_in**5 + a_in**6) ! ! #################################################################### ! @@ -11144,6 +13349,11 @@ subroutine nssl_2mom_gs & jstag = 0 kstag = 1 + lrescalelow(:) = rescale_low_alpha + lrescalelow(lr) = rescale_low_alphar .and. rescale_low_alpha + lrescalelow(lh) = rescale_low_alphah .and. rescale_low_alpha + IF ( lf > 1 ) lrescalelow(lf) = rescale_low_alphah .and. rescale_low_alpha + IF ( lhl > 1 ) lrescalelow(lhl) = rescale_low_alphahl .and. rescale_low_alpha ! @@ -11200,7 +13410,7 @@ subroutine nssl_2mom_gs & ! constants ! - cp608 = 0.608 +! cp608 = 0.608 aradcw = -0.27544 bradcw = 0.26249e+06 cradcw = -1.8896e+10 @@ -11231,7 +13441,7 @@ subroutine nssl_2mom_gs & gf4p5 = 11.63172839656745 ! gamma(4.0+0.5) gf3ds = 3.0458730354120997 ! gamma(3.0+ds) gf1ds = 0.8863557896089221 ! gamma(1.0+ds) - gr = 9.8 + gf43rds = 0.8929795116 ! gamma(4./3.) gf53rds = 0.9027452930 ! gamma(5./3.) gf73rds = 1.190639349 ! gamma(7./3.) @@ -11261,11 +13471,18 @@ subroutine nssl_2mom_gs & vmlt = Min(xvmx(lr), 0.523599*(dmlt)**3 ) vshd = Min(xvmx(lr), 0.523599*(dshd)**3 ) - snowmeltmass = pi/6.0 * 1000. * snowmeltdia**3 ! maximum rain particle mass from melting snow (if snowmeltdia > 0) + IF ( snowmeltdia > 0.0 ) THEN + snowmeltmass = pi/6.0 * 1000. * snowmeltdia**3 ! maximum rain particle mass from melting snow (if snowmeltdia > 0) + ENDIF tdtol = 1.0e-05 tfrcbw = tfr - cbw tfrcbi = tfr - cbi + + IF ( mixedphase ) THEN + ibinhmlr = 0 + ibinhlmlr = 0 + ENDIF ! ! ! #ifdef COMMAS @@ -11417,35 +13634,25 @@ subroutine nssl_2mom_gs & do ix = nxmpb,itile pqs(1) = t00(ix,jy,kz) -! pqs(kz) = t00(ix,jy,kz) theta(1) = an(ix,jy,kz,lt) temg(1) = t0(ix,jy,kz) temcg(1) = temg(1) - tfr tqvcon = temg(1)-cbw - ltemq = (temg(1)-163.15)/fqsat+1.5 + ltemq = (temg(1)-163.15)/fqsat + 1.5 ltemq = Min( nqsat, Max(1,ltemq) ) qvs(1) = pqs(1)*tabqvs(ltemq) - qis(1) = pqs(1)*tabqis(ltemq) + IF ( iqis0 == 1 .or. temg(1) <= tfr+0.5 ) THEN + qis(1) = pqs(1)*tabqis(ltemq) + ELSE + ltemq = (tfr - 163.15)/fqsat + 1.5 + qis(1) = pqs(1)*tabqis(ltemq) + ENDIF qss(1) = qvs(1) -! IF ( jy .eq. 1 .and. ix .eq. 24 ) THEN -! write(91,*) 'kz,qv,th: ',kz,an(ix,jy,kz,lv),an(ix,jy,kz,lt),pqs(kz),tabqvs(ltemq),qvs(kz) -! ENDIF - if ( temg(1) .lt. tfr ) then -! if( qcw(kz) .le. qxmin(lc) .and. qci(kz) .gt. qxmin(li)) -! > qss(kz) = qis(kz) -! if( qcw(kz) .gt. qxmin(lc) .and. qci(kz) .gt. qxmin(li)) -! > qss(kz) = (qcw(kz)*qvs(kz) + qci(kz)*qis(kz)) / -! > (qcw(kz) + qci(kz)) - qss(1) = qis(1) - else -! IF ( an(ix,jy,kz,lv) .gt. qss(kz) ) THEN -! write(iunit,*) 'qss exceeded at ',ix,jy,kz,qss(kz),an(ix,jy,kz,lv),temg(kz) -! write(iunit,*) 'other temg = ',theta(kz)*(pinit(kz)+p2(ix,jy,kz)) -! ENDIF + qss(1) = qis(1) end if ! ishail = .false. @@ -11521,7 +13728,12 @@ subroutine nssl_2mom_gs & ltemq = (temg(mgs)-163.15)/fqsat+1.5 ltemq = Min( nqsat, Max(1,ltemq) ) qvs(mgs) = pqs(mgs)*tabqvs(ltemq) - qis(mgs) = pqs(mgs)*tabqis(ltemq) + IF ( iqis0 == 1 .or. temg(mgs) <= tfr+0.5 ) THEN + qis(mgs) = pqs(mgs)*tabqis(ltemq) + ELSE + ltemq = (tfr - 163.15)/fqsat + 1.5 + qis(mgs) = pqs(mgs)*tabqis(ltemq) + ENDIF qss(mgs) = qvs(mgs) ! es(mgs) = 6.1078e2*tabqvs(ltemq) ! eis(mgs) = 6.1078e2*tabqis(ltemq) @@ -11562,78 +13774,6 @@ subroutine nssl_2mom_gs & - scx(:,:) = 0.0 -! -! set shape parameters -! - IF ( imurain == 1 ) THEN - alpha(:,lr) = alphar - ELSEIF ( imurain == 3 ) THEN - alpha(:,lr) = xnu(lr) - ENDIF - - alpha(:,li) = xnu(li) - alpha(:,lc) = xnu(lc) - - IF ( imusnow == 1 ) THEN - alpha(:,ls) = alphas - ELSEIF ( imusnow == 3 ) THEN - alpha(:,ls) = xnu(ls) - ENDIF - - DO il = lr,lhab - do mgs = 1,ngscnt - IF ( il .ge. lg ) alpha(mgs,il) = dnu(il) - - - DO ic = lc,lhab - dab0lh(mgs,il,ic) = dab0(il,ic) ! dab0(ic,il) - dab1lh(mgs,il,ic) = dab1(il,ic) ! dab1(ic,il) - ENDDO - ENDDO - end do - - -! DO mgs = 1,ngscnt - DO il = lr,lhab - da0lx(:,il) = da0(il) - ENDDO - da0lh(:) = da0(lh) - da0lr(:) = da0(lr) - da1lr(:) = da1(lr) - da0lc(:) = da0(lc) - da1lc(:) = da1(lc) - - - IF ( lzh < 1 .or. lzhl < 1 ) THEN - rzxhlh(:) = rzhl/rz - ELSEIF ( lzh > 1 .and. lzhl > 1 ) THEN - rzxhlh(:) = 1. - ENDIF - IF ( lzr > 1 ) THEN - rzxh(:) = 1. - rzxhl(:) = 1. - ELSE - rzxh(:) = rz - rzxhl(:) = rzhl - ENDIF - - IF ( imurain == 1 .and. imusnow == 3 .and. lzr < 1 ) THEN - rzxs(:) = rzs - ELSEIF ( imurain == imusnow .or. lzr > 1 ) THEN - rzxs(:) = 1. - ENDIF - ! ENDDO - - IF ( lhl .gt. 1 ) THEN - DO mgs = 1,ngscnt - da0lhl(mgs) = da0(lhl) - ENDDO - ENDIF - - ventrx(:) = ventr - ventrxn(:) = ventrn - gf1palp(:) = gamma_sp(1.0 + alphar) ! ! set concentrations @@ -11802,6 +13942,124 @@ subroutine nssl_2mom_gs & +! +! 6th moments +! + + IF ( ipconc .ge. 6 ) THEN + zx(:,:) = 0.0 + DO il = lr,lhab + IF ( lz(il) .gt. 1 ) THEN + DO mgs = 1,ngscnt + zx(mgs,il) = Max( an(igs(mgs),jy,kgs(mgs),lz(il)), 0.0 ) + ENDDO + ENDIF + ENDDO + + ENDIF + + IF ( ipconc .ge. 6 ) THEN + + IF ( lz(lr) .lt. 1 ) THEN + g1x(:,lr) = (6.0 + alphar)*(5.0 + alphar)*(4.0 + alphar)/ & + & ((3.0 + alphar)*(2.0 + alphar)*(1.0 + alphar)) + + + DO mgs = 1,ngscnt + IF ( cx(mgs,lr) .gt. 0.0 .and. qx(mgs,lr) .gt. qxmin(lr) ) THEN + + vr = rho0(mgs)*qx(mgs,lr)/(1000.*cx(mgs,lr)) + IF ( lzr < 1 ) THEN + IF ( imurain == 3 ) THEN + zx(mgs,lr) = 3.6476*(rnu+2.0)*cx(mgs,lr)*vr**2/(rnu+1.0) + ELSE ! imurain == 1 + zx(mgs,lr) = 3.6476*g1x(mgs,lr)*cx(mgs,lr)*vr**2 + ENDIF + ENDIF + + ENDIF + ENDDO + ENDIF + + ENDIF + + + scx(:,:) = 0.0 +! +! set shape parameters +! + if ( ndebug .gt. 0 .and. my_rank>=0 ) write(0,*) my_rank, 'ICEZVD_GS: dbg = set alpha' + IF ( imurain == 1 ) THEN + alpha(:,lr) = alphar + ELSEIF ( imurain == 3 ) THEN + alpha(:,lr) = xnu(lr) + ENDIF + + alpha(:,li) = xnu(li) + alpha(:,lc) = xnu(lc) + + IF ( imusnow == 1 ) THEN + alpha(:,ls) = alphas + ELSEIF ( imusnow == 3 ) THEN + alpha(:,ls) = xnu(ls) + ENDIF + + if ( ndebug .gt. 0 .and. my_rank>=0 ) write(0,*) my_rank, 'ICEZVD_GS: dbg = set dab' + + DO il = lr,lhab + do mgs = 1,ngscnt + IF ( il .ge. lg ) alpha(mgs,il) = dnu(il) + + + DO ic = lc,lhab + dab0lh(mgs,il,ic) = dab0(il,ic) ! dab0(ic,il) + dab1lh(mgs,il,ic) = dab1(il,ic) ! dab1(ic,il) + ENDDO + end do + ENDDO + + +! DO mgs = 1,ngscnt + DO il = lr,lhab + da0lx(:,il) = da0(il) + ENDDO + da0lh(:) = da0(lh) + da0lr(:) = da0(lr) + da1lr(:) = da1(lr) + da0lc(:) = da0(lc) + da1lc(:) = da1(lc) + + if ( ndebug .gt. 0 .and. my_rank>=0 ) write(0,*) my_rank, 'ICEZVD_GS: dbg = set rz' + + IF ( lzh < 1 .or. lzhl < 1 ) THEN + rzxhlh(:) = rzhl/rz + ELSEIF ( lzh > 1 .and. lzhl > 1 ) THEN + rzxhlh(:) = 1. + ENDIF + IF ( lzr > 1 ) THEN + rzxh(:) = 1. + rzxhl(:) = 1. + ELSE + rzxh(:) = rz + rzxhl(:) = rzhl + ENDIF + + IF ( imurain == 1 .and. imusnow == 3 .and. lzr < 1 ) THEN + rzxs(:) = rzs + ELSEIF ( imurain == imusnow .or. lzr > 1 ) THEN + rzxs(:) = 1. + ENDIF + ! ENDDO + + IF ( lhl .gt. 1 ) THEN + DO mgs = 1,ngscnt + da0lhl(mgs) = da0(lhl) + ENDDO + ENDIF + + ventrx(:) = ventr + ventrxn(:) = ventrn + gf1palp(:) = gamma_sp(1.0 + alphar) ! ! set factors @@ -11840,6 +14098,7 @@ subroutine nssl_2mom_gs & tmp = qx(mgs,li)+qx(mgs,ls)+qx(mgs,lh) IF ( lhl > 1 ) tmp = tmp + qx(mgs,lhl) + IF ( lf > 1 ) tmp = tmp + qx(mgs,lf) cvm = cv+cvv*qx(mgs,lv)+cpl*(qx(mgs,lc)+qx(mgs,lr)) & +cpigb*(tmp) @@ -11962,6 +14221,7 @@ subroutine nssl_2mom_gs & IF ( lhl .gt. 1 ) THEN xdn(mgs,lhl) = xdn0(lhl) + xdntmp(mgs,lhl) = xdn0(lhl) IF ( lvol(lhl) .gt. 1 ) THEN IF ( vx(mgs,lhl) .gt. 0.0 .and. qx(mgs,lhl) .gt. qxmin(lhl) ) THEN @@ -11973,6 +14233,7 @@ subroutine nssl_2mom_gs & xdn(mgs,lhl) = Min( dnmx, Max( xdnmn(lhl), rho0(mgs)*qx(mgs,lhl)/vx(mgs,lhl) ) ) vx(mgs,lhl) = rho0(mgs)*qx(mgs,lhl)/xdn(mgs,lhl) + xdntmp(mgs,lhl) = xdn(mgs,lhl) ELSEIF ( vx(mgs,lhl) == 0.0 .and. qx(mgs,lhl) .gt. qxmin(lhl) ) THEN ! if volume is zero, need to initialize the default value @@ -11986,33 +14247,851 @@ subroutine nssl_2mom_gs & end do + IF ( ipconc == 5 .and. imydiagalpha == 2 ) THEN - IF ( imurain == 3 ) THEN - IF ( lzr > 1 ) THEN - alphashr = 0.0 - alphamlr = -2.0/3.0 - ELSE - alphashr = xnu(lr) - alphamlr = xnu(lr) - ENDIF -! massfacshr = ( (2. + 3.*(1. +alphashr) )/( 3.*(1. + alphashr) ) )**(1./3.) ! this is the diameter factor -! massfacmlr = ( (2. + 3.*(1. +alphamlr) )/( 3.*(1. + alphamlr) ) )**(1./3.) - massfacshr = ( (2. + 3.*(1. +alphashr) )**3/( 3.*(1. + alphashr) ) ) ! this is the mass or volume factor - massfacmlr = ( (2. + 3.*(1. +alphamlr) )**3/( 3.*(1. + alphamlr) ) ) - ELSEIF ( imurain == 1 ) THEN - IF ( lzr > 1 ) THEN - alphashr = 4.0 - alphamlr = 4.0 - ELSE - alphashr = alphar - alphamlr = alphar - ENDIF -! massfacshr = (3.0 + alphashr)*((3.+alphashr)*(2.+alphashr)*(1. + alphashr) )**(-1./3.) ! this is the diameter factor -! massfacmlr = (3.0 + alphamlr)*((3.+alphamlr)*(2.+alphamlr)*(1. + alphamlr) )**(-1./3.) + cwchtmp = ((3. + dnu(lh))*(2. + dnu(lh))*(1.0 + dnu(lh)))**(-1./3.) + + DO mgs = 1,ngscnt + !IF ( igs(mgs) == 19 ) write(0,*) 'k,qr,qh,cr,ch = ',kgs(mgs),qx(mgs,lr),cx(mgs,lr),qx(mgs,lh),cx(mgs,lh) + IF ( qx(mgs,lr) .gt. qxmin(lr) .and. cx(mgs,lr) > cxmin ) THEN + xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xdn(mgs,lr)*cx(mgs,lr)) ! + xdia(mgs,lr,3) = (xv(mgs,lr)*6.0*cwc1)**(1./3.) + ! alpha(mgs,lr) = Min(alphamax, c1r*tanh(c2r*(xdia(mgs,lr,3)*1000. - c3r)) + c4r) + ! IF ( igs(mgs) == 19 ) write(0,*) 'imy: i,k,alpr,xdia = ',igs(mgs),kgs(mgs),alpha(mgs,lr),xdia(mgs,lr,3)*1000. + + ! M&M-C 2010: + tmp = 4. + alphar + i = Int(dgami*(tmp)) + del = tmp - dgam*i + x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + + tmp = 1. + alphar + i = Int(dgami*(tmp)) + del = tmp - dgam*i + y = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + + tmp = (x/y)**(1./3.)*xdia(mgs,lr,3)*cwchtmp + + alpha(mgs,lr) = Min(15., 11.8*(1000.*tmp - 0.7)**2 + 2.) + ENDIF + IF ( qx(mgs,lh) .gt. qxmin(lh) .and. cx(mgs,lh) > cxmin ) THEN +! MY 2005: + xv(mgs,lh) = rho0(mgs)*qx(mgs,lh)/(xdn(mgs,lh)*cx(mgs,lh)) ! + xdia(mgs,lh,3) = (xv(mgs,lh)*6.*piinv)**(1./3.) ! mwfac*xdia(mgs,lh,1) ! (xv(mgs,lh)*cwc0*6.0)**(1./3.) +! alpha(mgs,lh) = Min(alphamax, c1h*tanh(c2h*(xdia(mgs,lh,3)*1000. - c3h)) + c4h) + + ! M&M-C 2010: + tmp = 4. + dnu(lh) + i = Int(dgami*(tmp)) + del = tmp - dgam*i + x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + + tmp = 1. + dnu(lh) + i = Int(dgami*(tmp)) + del = tmp - dgam*i + y = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + + tmp = (x/y)**(1./3.)*xdia(mgs,lh,3)*cwchtmp + + alpha(mgs,lh) = Min(15., 11.8*(1000.*tmp - 0.7)**2 + 2.) + ! alphan(mgs,lh) = alpha(mgs,lh) + + ! IF ( igs(mgs) == 19 ) write(0,*) 'imy: i,k,alph,xdia = ',igs(mgs),kgs(mgs),alpha(mgs,lh),xdia(mgs,lh,3)*1000. + il = lh + DO ic = lc,lh-1 ! lhab + i = Nint( alpha(mgs,il)*dqiacralphainv ) + IF ( ic == lc .or. ic == li .or. ic == ls .or. (ic == lr .and. imurain == 3) ) THEN + alp = (3.*alpha(mgs,ic) + 2.) + j = Nint( (3.*alpha(mgs,ic) + 2.)*dqiacralphainv ) + ELSE ! IF ( ic == lr .and. imurain == 1 ) ! rain + alp = alpha(mgs,ic) + j = Nint( alpha(mgs,ic)*dqiacralphainv ) + ENDIF + + dab0lh(mgs,ic,il) = dab0lu(j,i,ic,il) + dab1lh(mgs,ic,il) = dab1lu(j,i,ic,il) + dab0lh(mgs,il,ic) = dab0lu(i,j,il,ic) + dab1lh(mgs,il,ic) = dab1lu(i,j,il,ic) + ENDDO + ENDIF +! alpha(:,lr) = 0. ! 10. +! alpha(:,lh) = 0. ! 10. + IF ( lhl > 0 ) THEN + IF ( qx(mgs,lhl) .gt. qxmin(lhl) .and. cx(mgs,lhl) > cxmin ) THEN + xv(mgs,lhl) = rho0(mgs)*qx(mgs,lhl)/(xdn(mgs,lhl)*cx(mgs,lhl)) ! + xdia(mgs,lhl,3) = (xv(mgs,lhl)*6.*piinv)**(1./3.) + IF ( xdia(mgs,lhl,3) < 0.008 ) THEN + alpha(mgs,lhl) = Min(alphamax, c1hl*tanh(c2hl*(xdia(mgs,lhl,3)*1000. - c3hl)) + c4hl) + ELSE + alpha(mgs,lhl) = Min(alphamax, c5hl*xdia(mgs,lhl,3)*1000. + c6hl) + ENDIF + + il = lhl + DO ic = lc,lh-1 ! lhab + i = Nint( alpha(mgs,il)*dqiacralphainv ) + IF ( ic == lc .or. ic == li .or. ic == ls .or. (ic == lr .and. imurain == 3) ) THEN + alp = (3.*alpha(mgs,ic) + 2.) + j = Nint( (3.*alpha(mgs,ic) + 2.)*dqiacralphainv ) + ELSE ! IF ( ic == lr .and. imurain == 1 ) ! rain + alp = alpha(mgs,ic) + j = Nint( alpha(mgs,ic)*dqiacralphainv ) + ENDIF + + dab0lh(mgs,ic,il) = dab0lu(j,i,ic,il) + dab1lh(mgs,ic,il) = dab1lu(j,i,ic,il) + dab0lh(mgs,il,ic) = dab0lu(i,j,il,ic) + dab1lh(mgs,il,ic) = dab1lu(i,j,il,ic) + ENDDO + + ENDIF + ENDIF + + + + ENDDO + ENDIF + + + IF ( imurain == 3 ) THEN + IF ( lzr > 1 ) THEN + alphashr = 0.0 + alphamlr = -2.0/3.0 + alphasmlr = -2.0/3.0 + ELSE + alphashr = xnu(lr) + alphamlr = xnu(lr) + alphasmlr = xnu(lr) + ENDIF +! massfacshr = ( (2. + 3.*(1. +alphashr) )/( 3.*(1. + alphashr) ) )**(1./3.) ! this is the diameter factor +! massfacmlr = ( (2. + 3.*(1. +alphamlr) )/( 3.*(1. + alphamlr) ) )**(1./3.) + massfacshr = ( (2. + 3.*(1. +alphashr) )**3/( 3.*(1. + alphashr) ) ) ! this is the mass or volume factor + massfacmlr = ( (2. + 3.*(1. +alphamlr) )**3/( 3.*(1. + alphamlr) ) ) + ELSEIF ( imurain == 1 ) THEN + IF ( lzr > 1 ) THEN + alphashr = 4.0 + alphamlr = 4.0 + alphasmlr = alphasmlr0 + ELSE + alphashr = alphar + alphamlr = alphar + alphasmlr = alphar + ENDIF +! massfacshr = (3.0 + alphashr)*((3.+alphashr)*(2.+alphashr)*(1. + alphashr) )**(-1./3.) ! this is the diameter factor +! massfacmlr = (3.0 + alphamlr)*((3.+alphamlr)*(2.+alphamlr)*(1. + alphamlr) )**(-1./3.) massfacshr = (3.0 + alphashr)**3/((3.+alphashr)*(2.+alphashr)*(1. + alphashr) ) ! this is the mass or volume factor massfacmlr = (3.0 + alphamlr)**3/((3.+alphamlr)*(2.+alphamlr)*(1. + alphamlr) ) ENDIF +! Find shape parameter rain + + g1shr = 1.0 + g1mlr = 1.0 + g1smlr = 1.0 + +! CALL cld_cpu('Z-MOMENT-1') + + IF ( ipconc >= 6 ) THEN + + ! set base g1x in case rain is not 3-moment + IF ( ipconc >= 6 .and. imurain == 3 ) THEN + il = lr + DO mgs = 1,ngscnt +! g1x(mgs,il) = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + g1x(mgs,il) = (alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)) + ENDDO + ENDIF + + IF (lzr > 1 ) THEN + IF ( imurain == 3 ) THEN + g1shr = (alphashr+2.0)/((alphashr+1.0)) + g1mlr = (alphamlr+2.0)/((alphamlr+1.0)) + g1smlr = (alphasmlr+2.0)/((alphasmlr+1.0)) + ELSEIF ( imurain == 1 ) THEN +! g1shr = 36.*(6.0 + alphashr)*(5.0 + alphashr)*(4.0 + alphashr)/ & +! & (pi**2*(3.0 + alphashr)*(2.0 + alphashr)*(1.0 + alphashr)) + g1shr = (6.0 + alphashr)*(5.0 + alphashr)*(4.0 + alphashr)/ & + & ((3.0 + alphashr)*(2.0 + alphashr)*(1.0 + alphashr)) +! g1mlr = 36.*(6.0 + alphamlr)*(5.0 + alphamlr)*(4.0 + alphamlr)/ & +! & (pi**2*(3.0 + alphamlr)*(2.0 + alphamlr)*(1.0 + alphamlr)) + g1mlr = (6.0 + alphamlr)*(5.0 + alphamlr)*(4.0 + alphamlr)/ & + & ((3.0 + alphamlr)*(2.0 + alphamlr)*(1.0 + alphamlr)) + g1smlr = (6.0 + alphasmlr)*(5.0 + alphasmlr)*(4.0 + alphasmlr)/ & + & ((3.0 + alphasmlr)*(2.0 + alphasmlr)*(1.0 + alphasmlr)) + ENDIF + ENDIF + + IF ( lzr > 1 .and. imurain == 3 ) THEN ! { RAIN SHAPE PARAM + + +! CALL cld_cpu('Z-MOMENT-1r') + il = lr + DO mgs = 1,ngscnt + + + IF ( iresetmoments == 1 .or. iresetmoments == il .or. iresetmoments == -1 ) THEN ! .or. qx(mgs,il) <= qxmin(il) THEN + IF ( zx(mgs,il) <= zxmin ) THEN ! .and. qx(mgs,il) > 0.05e-3 THEN +!! write(91,*) 'zx=0; qx,cx = ',1000.*qx(mgs,il),cx(mgs,il) + qx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ELSEIF ( iresetmoments == -1 .and. qx(mgs,il) < qxmin(il) ) THEN + zx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + ELSEIF ( cx(mgs,il) <= cxmin .and. iresetmoments /= -1 ) THEN ! .and. qx(mgs,il) > 0.05e-3 THEN + + qx(mgs,lv) = qx(mgs,lv) + qx(mgs,il) + zx(mgs,lr) = 0.0 + qx(mgs,lr) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),lr) + an(igs(mgs),jgs,kgs(mgs),lr) = qx(mgs,lr) + an(igs(mgs),jgs,kgs(mgs),lz(lr)) = zx(mgs,lr) + ENDIF + ENDIF + + IF ( .false. .and. zx(mgs,il) <= zxmin .and. cx(mgs,il) <= cxmin ) THEN + zx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + ENDIF + + IF ( qx(mgs,lr) .gt. qxmin(lr) ) THEN + + xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xdn(mgs,lr)*Max(1.0e-11,cx(mgs,lr))) + IF ( xv(mgs,lr) .gt. xvmx(lr) ) THEN +! xv(mgs,lr) = xvmx(lr) +! cx(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xvmx(lr)*xdn(mgs,lr)) + ELSEIF ( xv(mgs,lr) .lt. xvmn(lr) ) THEN + xv(mgs,lr) = xvmn(lr) + cx(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xvmn(lr)*xdn(mgs,lr)) + ENDIF + + IF ( zx(mgs,il) > 0.0 .and. cx(mgs,il) <= 0.0 ) THEN +! have mass and reflectivity but no concentration, so set concentration, using default alpha + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + z = zx(mgs,il) + qr = qx(mgs,il) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z*xdn(mgs,lr)**2) +! an(igs(mgs),jgs,kgs(mgs),ln(il)) = zx(mgs,il) + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) > 0.0 ) THEN +! have mass and concentration but no reflectivity, so set reflectivity, using default alpha + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + chw = cx(mgs,il) + qr = qx(mgs,il) + zx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(xdn(mgs,lr)**2*chw) + an(igs(mgs),jgs,kgs(mgs),lz(lr)) = zx(mgs,lr) + + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= 0.0 ) THEN +! How did this happen? + ! set values according to dBZ of -10, or Z = 0.1 +! 0.1 = 1.e18*0.224*an(ix,jy,kz,lzh)*(hwdn/rwdn)**2 + zx(mgs,il) = 1.e-19/0.224*(xdn0(lr)/xdn0(il))**2 + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + z = zx(mgs,il) + qr = qx(mgs,il) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z*1000.*1000) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ENDIF + + IF ( zx(mgs,lr) > 0.0 ) THEN + xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(1000.*cx(mgs,lr)) + vr = xv(mgs,lr) + qr = qx(mgs,lr) + nrx = cx(mgs,lr) + z = zx(mgs,lr) + +! xv = (db(1,kz)*a(1,1,kz,lr))**2/(a(1,1,kz,lnr)) +! rd = z*(pi/6.*1000.)**2/xv + +! determine shape parameter alpha by iteration + IF ( z .gt. 0.0 ) THEN +! alpha(mgs,lr) = 3. + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. + DO i = 1,20 + IF ( Abs(alp - alpha(mgs,lr)) .lt. 0.01 ) EXIT + alpha(mgs,lr) = Max( rnumin, Min( rnumax, alp ) ) + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. + alp = Max( rnumin, Min( rnumax, alp ) ) + ENDDO + +! check for artificial breakup (rain larger than allowed max size) + IF ( (xv(mgs,il) .gt. xvmx(il) .or. (ioldlimiter >= 2 .and. xv(mgs,il) .gt. xvmx(il)/8.) )) THEN + tmp = cx(mgs,il) + IF ( ioldlimiter >= 2 ) THEN ! MY-style active breakup + x = (6.*rho0(mgs)*qx(mgs,il)/(pi*xdn(mgs,il)*cx(mgs,il)))**(1./3.) + x1 = Max(0.0e-3, x - 3.0e-3) + x2 = Max(0.5, x/6.0e-3) + x3 = x2**3 + cx(mgs,il) = cx(mgs,il)*Max((1.+2.222e3*x1**2), x3) + xv(mgs,il) = xv(mgs,il)/Max((1.+2.222e3*x1**2), x3) + ELSE ! simple cutoff + xv(mgs,il) = Min( xvmx(il), Max( xvmn(il),xv(mgs,il) ) ) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il)) + ENDIF + !xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + !cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il)) + + IF ( tmp < cx(mgs,il) ) THEN ! breakup + + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + zx(mgs,il) = zx(mgs,il) + g1*(rho0(mgs)/xdn(mgs,il))**2*( (qx(mgs,il)/tmp)**2 * (tmp-cx(mgs,il)) ) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + vr = xv(mgs,lr) + qr = qx(mgs,lr) + nrx = cx(mgs,lr) + z = zx(mgs,lr) + + +! determine shape parameter alpha by iteration + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. + DO i = 1,20 + IF ( Abs(alp - alpha(mgs,lr)) .lt. 0.01 ) EXIT + alpha(mgs,lr) = Max( rnumin, Min( rnumax, alp ) ) + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. + alp = Max( rnumin, Min( rnumax, alp ) ) + ENDDO + + + ENDIF + ENDIF + +! +! Check whether the shape parameter is at or less than the minimum, and if it is, reset the +! concentration or reflectivity to match (prevents reflectivity from being out of balance with Q and N) +! + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + IF ( .true. .and. (alpha(mgs,il) <= rnumin .or. alp == rnumin .or. alp == rnumax) ) THEN + + IF ( rescale_high_alpha .and. alp >= rnumax - 0.01 ) THEN ! reset c at high alpha to prevent growth in Z + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z*(1./(xdn(mgs,il)))**2 + an(igs(mgs),jy,kgs(mgs),ln(il)) = cx(mgs,il) + + ELSEIF ( rescale_low_alphar .and. alp <= rnumin ) THEN + z = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/((alpha(mgs,lr)+1.0)*pi**2) + zx(mgs,il) = z + an(igs(mgs),jy,kgs(mgs),lz(il)) = zx(mgs,il) + ENDIF + ENDIF + + ! set g1x to use as G factor later. If alpha is in the range ( rnumin < alpha < rnumax ), then + ! this will be the same as computing G from alpha. If alpha = rnumax, however, it probably means that + ! the moments are not matched correctly, so we compute G from the moments instead so that the dZ/dt rates + ! stay consistent with dN/dt and dq/dt. + IF ( alp >= rnumax - 0.01 ) THEN +! g1x(mgs,il) = 6**2*zx(mgs,il)/(cx(mgs,il)*(pi*xv(mgs,lr))**2) +! g1x(mgs,il) = xdn(mgs,il)*zx(mgs,il)*cx(mgs,il)/((rho0(mgs)*qx(mgs,lr))**2) + g1x(mgs,il) = (pi*xdn(mgs,il))**2*zx(mgs,il)*cx(mgs,il)/((6.*rho0(mgs)*qx(mgs,il))**2) + ELSE + g1x(mgs,il) = g1 + ENDIF + + tmp = alpha(mgs,lr) + 4./3. + i = Int(dgami*(tmp)) + del = tmp - dgam*i + x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + + tmp = alpha(mgs,lr) + 1. + i = Int(dgami*(tmp)) + del = tmp - dgam*i + y = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + + gf1palp(mgs) = y + +! ventrx(mgs) = Gamma_sp(alpha(mgs,lr) + 4./3.)/(alpha(mgs,lr) + 1.)**(1./3.)/Gamma_sp(alpha(mgs,lr) + 1.) + ventrx(mgs) = x/(y*(alpha(mgs,lr) + 1.)**(1./3.)) + + IF ( imurain == 3 .and. izwisventr == 2 ) THEN + + tmp = alpha(mgs,lr) + 1.5 + br/6. + i = Int(dgami*(tmp)) + del = tmp - dgam*i + x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + +! ventrx(mgs) = Gamma_sp(alpha(mgs,lr) + 1.5 + br/6.)/Gamma_sp(alpha(mgs,lr) + 1.) + ventrxn(mgs) = x/(y*(alpha(mgs,lr) + 1.)**((1.+br)/6. + 1./3.)) + +! This whole section is imurain == 3, so this branch never runs +! ELSEIF ( imurain == 1 .and. iferwisventr == 2 ) THEN +! +! tmp = alpha(mgs,lr) + 2.5 + br/2. +! i = Int(dgami*(tmp)) +! del = tmp - dgam*i +! x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami +! +!! ventrx(mgs) = Gamma_sp(alpha(mgs,lr) + 1.5 + br/6.)/Gamma_sp(alpha(mgs,lr) + 1.) +! ventrxn(mgs) = x/y + + + ENDIF + + ENDIF + ENDIF + + ENDIF + + ENDDO +! CALL cld_cpu('Z-MOMENT-1r') + ENDIF ! } + + ENDIF ! ipconc >= 6 + +! Find shape parameters for graupel and hail + IF ( ipconc .ge. 6 ) THEN + + DO il = lr,lhab + + ! set base values of g1x + IF ( (.not. ( il == lr .and. imurain == 3 )) .and. ( il == lr .or. il == lh .or. il == lhl .or. il == lf ) ) THEN + DO mgs = 1,ngscnt + g1x(mgs,il) = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + ENDDO + ENDIF + + IF ( lz(il) .gt. 1 .and. ( .not. ( il == lr .and. imurain == 3 )) ) THEN + + DO mgs = 1,ngscnt + + + IF ( iresetmoments == 1 .or. iresetmoments == il .or. iresetmoments == -1 ) THEN ! .or. qx(mgs,il) <= qxmin(il) ) THEN + IF ( zx(mgs,il) <= zxmin ) THEN ! .and. qx(mgs,il) > 0.05e-3 ) THEN +!! write(91,*) 'zx=0; qx,cx = ',1000.*qx(mgs,il),cx(mgs,il) + qx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + zx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + ELSEIF ( iresetmoments == -1 .and. qx(mgs,il) < qxmin(il) ) THEN + zx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + ELSEIF ( cx(mgs,il) <= cxmin .and. iresetmoments /= -1 ) THEN ! .and. qx(mgs,il) > 0.05e-3 ) THEN + qx(mgs,lv) = qx(mgs,lv) + qx(mgs,il) + zx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ENDIF + ENDIF + + IF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= cxmin ) THEN + zx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + ENDIF + + IF ( qx(mgs,il) .gt. qxmin(il) ) THEN + + xv(mgs,il) = rho0(mgs)*qx(mgs,il)/(xdn(mgs,il)*Max(1.0e-9,cx(mgs,il))) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + + IF ( xv(mgs,il) .lt. xvmn(il) ) THEN + xv(mgs,il) = Min( xvmx(il), Max( xvmn(il),xv(mgs,il) ) ) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il)) + ENDIF + + IF ( zx(mgs,il) > 0.0 .and. cx(mgs,il) <= 0.0 ) THEN +! have mass and reflectivity but no concentration, so set concentration, using default alpha + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + z = zx(mgs,il) + qr = qx(mgs,il) +! cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(6.*qr)**2/(z*(pi*xdn(mgs,il))**2) + + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) > cxmin ) THEN +! have mass and concentration but no reflectivity, so set reflectivity, using default alpha +! g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & +! & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + chw = cx(mgs,il) + qr = qx(mgs,il) +! zx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/chw +! zx(mgs,il) = Min(zxmin*1.1, g1*dn(igs(mgs),jy,kgs(mgs))**2*(6.*qr)**2/(chw*(pi*xdn(mgs,il))**2) ) + g1 = (6.0 + alphamax)*(5.0 + alphamax)*(4.0 + alphamax)/ & + & ((3.0 + alphamax)*(2.0 + alphamax)*(1.0 + alphamax)) + zx(mgs,il) = Max(zxmin*1.1, g1*dn(igs(mgs),jy,kgs(mgs))**2*(6*qr)**2/(chw*(pi*xdn(mgs,il))**2) ) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= 0.0 ) THEN +! How did this happen? + ! set values according to dBZ of -10, or Z = 0.1 +! 0.1 = 1.e18*0.224*an(ix,jy,kz,lzh)*(hwdn/rwdn)**2 + zx(mgs,il) = 1.e-19/0.224*(xdn0(lr)/xdn0(il))**2 + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + z = zx(mgs,il) + qr = qx(mgs,il) +! cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(6.*qr)**2/(z*(pi*xdn(mgs,il))**2) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ELSE + + chw = cx(mgs,il) + qr = qx(mgs,il) + z = zx(mgs,il) + + IF ( zx(mgs,il) .gt. 0. ) THEN + +! rdi = z*(pi/6.*1000.)**2*chw/((rho0(mgs)*qr)**2) + rdi = z*(pi/6.*xdn(mgs,il))**2*chw/((rho0(mgs)*qr)**2) + +! alp = 1.e18*(6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ +! : ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 + alp = (6.0+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 +! print*,'kz, alp, alpha(mgs,il) = ',kz,alp,alpha(mgs,il),rdi,z,xv + alp = Max( alphamin, Min( alphamax, alp ) ) + + IF ( newton ) THEN + DO i = 1,10 + IF ( Abs(alp - alpha(mgs,il)) .lt. 0.01 ) EXIT + alpha(mgs,il) = Max( alphamin, Min( alphamax, alp ) ) + alp = alp + ( galpha(alp) - rdi )/dgalpha(alp) + alp = Max( alphamin, Min( alphamax, alp ) ) + ENDDO + + ELSE + DO i = 1,10 +! IF ( 100.*Abs(alp - alpha(mgs,il))/(Abs(alpha(mgs,il))+1.e-5) .lt. 1. ) EXIT + IF ( Abs(alp - alpha(mgs,il)) .lt. 0.01 ) EXIT + alpha(mgs,il) = Max( alphamin, Min( alphamax, alp ) ) +! alp = 1.e18*(6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ +! : ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 + alp = (6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 +! print*,'i,alp = ',i,alp + alp = Max( alphamin, Min( alphamax, alp ) ) + ENDDO + ENDIF + + +! check for artificial breakup (graupel/hail larger than allowed max size) + IF ( imaxdiaopt == 1 ) THEN + xvbarmax = xvmx(il) + ELSEIF ( imaxdiaopt == 2 ) THEN ! test against maximum mass diameter + xvbarmax = xvmx(il) /((3. + alpha(mgs,il))**3/((3. + alpha(mgs,il))*(2. + alpha(mgs,il))*(1. + alpha(mgs,il)))) + ELSEIF ( imaxdiaopt == 3 ) THEN ! test against mass-weighted diameter + xvbarmax = xvmx(il) /((4. + alpha(mgs,il))**3/((3. + alpha(mgs,il))*(2. + alpha(mgs,il))*(1. + alpha(mgs,il)))) + ELSE + xvbarmax = xvmx(il) + ENDIF + + IF ( xv(mgs,il) .gt. xvbarmax .or. (il == lr .and. ioldlimiter >= 2 .and. xv(mgs,il) .gt. xvmx(il)/8.)) THEN + tmp = cx(mgs,il) + IF( ioldlimiter >= 2 .and. il == lr) THEN ! MY-style drop limiter for rain + x = (6.*rho0(mgs)*qx(mgs,il)/(pi*xdn(mgs,il)*cx(mgs,il)))**(1./3.) + x1 = Max(0.0e-3, x - 3.0e-3) + x2 = Max(0.5, x/6.0e-3) + x3 = x2**3 + cx(mgs,il) = cx(mgs,il)*Max((1.+2.222e3*x1**2), x3) + xv(mgs,il) = xv(mgs,il)/Max((1.+2.222e3*x1**2), x3) + ELSE + xv(mgs,il) = Min( xvbarmax, Max( xvmn(il),xv(mgs,il) ) ) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il)) + ENDIF + IF ( tmp < cx(mgs,il) ) THEN ! artificial breakup has happened, so need to adjust reflectivity and find new shape parameter + g1 = 36.*(6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))*pi**2) + zx(mgs,il) = zx(mgs,il) + g1*(rho0(mgs)/xdn(mgs,il))**2*( (qx(mgs,il)/tmp)**2 * (tmp-cx(mgs,il)) ) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + chw = cx(mgs,il) + qr = qx(mgs,il) + z = zx(mgs,il) + + rdi = z*(pi/6.*xdn(mgs,il))**2*chw/((rho0(mgs)*qr)**2) + alp = (6.0+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 + DO i = 1,10 + IF ( Abs(alp - alpha(mgs,il)) .lt. 0.01 ) EXIT + alpha(mgs,il) = Max( alphamin, Min( alphamax, alp ) ) + alp = (6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 + alp = Max( alphamin, Min( alphamax, alp ) ) + ENDDO + + + ENDIF + ENDIF + +! +! Check whether the shape parameter is at or less than the minimum, and if it is, reset the +! concentration or reflectivity to match (prevents reflectivity from being out of balance with Q and N) +! + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + + IF ( ( lrescalelow(il) .or. rescale_high_alpha ) .and. & + & ( alpha(mgs,il) <= alphamin .or. alp == alphamin .or. alp == alphamax ) ) THEN + + + + IF ( rescale_high_alpha .and. alp >= alphamax - 0.01 ) THEN ! reset c at high alpha to prevent growth in Z + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z*(6./(pi*xdn(mgs,il)))**2 + an(igs(mgs),jy,kgs(mgs),ln(il)) = cx(mgs,il) + + ELSEIF ( lrescalelow(il) .and. alp <= alphamin .and. .not. (il == lh .and. icvhl2h > 0 ) .and. & + .not. ( il == lr .and. .not. rescale_low_alphar ) ) THEN ! alpha = alphamin, so reset Z to prevent growth in C + wtest = .false. + IF ( irescalerainopt == 0 ) THEN + wtest = .false. + ELSEIF ( irescalerainopt == 1 ) THEN + wtest = qx(mgs,lc) > qxmin(lc) + ELSEIF ( irescalerainopt == 2 ) THEN + wtest = qx(mgs,lc) > qxmin(lc) .and. wvel(mgs) < rescale_wthresh + ELSEIF ( irescalerainopt == 3 ) THEN + wtest = temcg(mgs) > rescale_tempthresh .and. qx(mgs,lc) > qxmin(lc) .and. wvel(mgs) < rescale_wthresh + ENDIF + + IF ( il == lr .and. ( wtest ) ) THEN +! IF ( temcg(mgs) > 0.0 .and. il == lr .and. qx(mgs,lc) > qxmin(lc) ) THEN + ! certain situations where rain number is adjusted instead of Z. Helps avoid rain being 'zapped' by autoconverted + ! drops (i.e., favor preserving Z when alpha tries to go negative) + chw = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z*(6./(pi*xdn(mgs,il)))**2 ! g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z1 + cx(mgs,il) = chw + an(igs(mgs),jy,kgs(mgs),ln(il)) = chw + ELSE + + ! Usual resetting of reflectivity moment to force consisntency between Q, N, Z, and alpha when alpha = alphamin + z1 = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/chw + z = z1*(6./(pi*xdn(mgs,il)))**2 + zx(mgs,il) = z + an(igs(mgs),jy,kgs(mgs),lz(il)) = z + ENDIF + ENDIF + ENDIF + + + ! set g1x to use as G factor later. If alpha is in the range ( rnumin < alpha < rnumax ), then + ! this will be the same as computing G from alpha. If alpha = rnumax, however, it probably means that + ! the moments are not matched correctly, so we compute G from the moments instead so that the dZ/dt rates + ! stay consistent with dN/dt and dq/dt. +! g1x(mgs,il) = zx(mgs,il)*chw*(pi*xdn(mgs,il))**2/(6.*qr*dn(igs(mgs),jy,kgs(mgs)))**2 +! g1x(mgs,il) = g1 ! zx(mgs,il)*cx(mgs,il)/(qr)**2 + IF ( alp >= alphamax - 0.5 ) THEN +! g1x(mgs,il) = 6**2*zx(mgs,il)/(cx(mgs,il)*(pi*xv(mgs,lr))**2) +! g1x(mgs,il) = (xdn(mgs,il))**2*zx(mgs,il)*cx(mgs,il)/((rho0(mgs)*qx(mgs,il))**2) + g1x(mgs,il) = (pi*xdn(mgs,il))**2*zx(mgs,il)*cx(mgs,il)/((6.*rho0(mgs)*qx(mgs,il))**2) + ELSE + g1x(mgs,il) = g1 + ENDIF + + ENDIF + +! IF ( ny .eq. 2 ) THEN +! IF ( qr .gt. 1.e-3 ) THEN +! write(0,*) 'alphah at nstep,i,k = ',dtp*(nstep-1),igs(mgs),kgs(mgs),alpha(mgs,il),qr*1000. +! ENDIF +! ENDIF + + + ENDIF ! .true. + + IF ( il == lr ) THEN + +! tmp = alpha(mgs,lr) + 4./3. +! i = Int(dgami*(tmp)) +! del = tmp - dgam*i +! x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami +! +! tmp = alpha(mgs,lr) + 1. +! i = Int(dgami*(tmp)) +! del = tmp - dgam*i +! y = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami +! +!! ventrx(mgs) = Gamma_sp(alpha(mgs,lr) + 4./3.)/(alpha(mgs,lr) + 1.)**(1./3.)/Gamma_sp(alpha(mgs,lr) + 1.) +! ventrx(mgs) = x/(y*(alpha(mgs,lr) + 1.)**(1./3.)) + + + tmp = alpha(mgs,lr) + 1. + i = Int(dgami*(tmp)) + del = tmp - dgam*i + y = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + + gf1palp(mgs) = y + + IF ( iferwisventr == 2 ) THEN + tmp = alpha(mgs,lr) + 2.5 + br/2. + i = Int(dgami*(tmp)) + del = tmp - dgam*i + x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + +! ventrx(mgs) = Gamma_sp(alpha(mgs,lr) + 1.5 + br/6.)/Gamma_sp(alpha(mgs,lr) + 1.) + + ventrxn(mgs) = x/y + + ENDIF + + ENDIF ! il==lr + + + ELSE ! below mass threshold +! g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ +! & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) +! z1 = g1*rho0(mgs)**2*(qr)*qr/chw +! z = 1.e18*z1*(6./(pi*1000.))**2 +! z = z1*(6./(pi*1000.))**2 +! zx(mgs,il) = z +! an(igs(mgs),jy,kgs(mgs),lz(il)) = z + ENDIF ! ( qx(mgs,il) .gt. qxmin(il) ) + + + +! ENDIF + ENDDO ! mgs + +! CALL cld_cpu('Z-DELABK') + +! IF ( il == lr ) THEN +! xnutmp = (alpha(mgs,il) - 2.)/3. +! da0lr(mgs) = delbk(bb(il), xnutmp, xmu(il), 0) +! ENDIF + + IF ( .not. ( il == lr .and. imurain == 3 ) ) THEN +! CALL cld_cpu('Z-DELABK') + DO mgs = 1,ngscnt + IF ( qx(mgs,il) > qxmin(il) ) THEN + xnutmp = (alpha(mgs,il) - 2.)/3. + +! IF ( .true. ) THEN + DO ic = lc,lh-1 ! lhab + IF ( il .ne. ic .and. qx(mgs,ic) .gt. qxmin(ic)) THEN + xnuc = xnu(ic) + IF ( ic == lc .and. idiagnosecnu > 0 ) xnuc = alpha(mgs,lc) ! alpha for droplets is actually nu + IF ( il /= lr .and. ic == lr .and. lzr > 1 ) THEN + IF ( imurain == 3 ) THEN + xnuc = alpha(mgs,lr) ! alpha is nu already + ELSE + xnuc = ( alpha(mgs,lr) - 2. )/3. ! convert alpha to nu + ENDIF + ENDIF + ! delabk(ba,bb,nua,nub,mua,mub,k), where a (il) is collector and b (ic) is collected + IF ( .false. ) THEN + dab0lh(mgs,ic,il) = delabk(bb(ic), bb(il), xnuc, xnutmp, xmu(ic), xmu(il), 0) !dab0(il,ic) + dab1lh(mgs,ic,il) = delabk(bb(ic), bb(il), xnuc, xnutmp, xmu(ic), xmu(il), 1) !dab1(il,ic) + dab0lh(mgs,il,ic) = delabk(bb(il), bb(ic), xnutmp, xnuc, xmu(il), xmu(ic), 0) !dab0(il,ic) + dab1lh(mgs,il,ic) = delabk(bb(il), bb(ic), xnutmp, xnuc, xmu(il), xmu(ic), 1) !dab1(il,ic) + ELSE ! use lookup table -- not interpolating yet because table resolution of 0.05 is good enough + i = Nint( alpha(mgs,il)*dqiacralphainv ) + IF ( ic == lc .or. ic == li .or. ic == ls .or. (ic == lr .and. imurain == 3) ) THEN + alp = (3.*alpha(mgs,ic) + 2.) + j = Nint( (3.*alpha(mgs,ic) + 2.)*dqiacralphainv ) + ELSE ! IF ( ic == lr .and. imurain == 1 ) ! rain + alp = alpha(mgs,ic) + j = Nint( alpha(mgs,ic)*dqiacralphainv ) + ENDIF + + dab0lh(mgs,ic,il) = dab0lu(j,i,ic,il) + dab1lh(mgs,ic,il) = dab1lu(j,i,ic,il) + dab0lh(mgs,il,ic) = dab0lu(i,j,il,ic) + dab1lh(mgs,il,ic) = dab1lu(i,j,il,ic) + +! tmp1 = dab0lu(j,i,ic,il) +! tmp2 = dab1lu(j,i,ic,il) +! tmp3 = dab0lu(i,j,il,ic) +! tmp4 = dab1lu(i,j,il,ic) +! tmp5 = delabk(bb(il), bb(ic), xnutmp, xnuc, xmu(ic), xmu(il), 0) !dab0(il,ic) +! tmp6 = delabk(bb(il), bb(ic), xnutmp, xnuc, xmu(ic), xmu(il), 1) !dab1(il,ic) +! tmp5 = delabk(bb(il), bb(ic), xnutmp, xnuc, xmu(il), xmu(ic), 0) !dab0(il,ic) +! tmp6 = delabk(bb(il), bb(ic), xnutmp, xnuc, xmu(il), xmu(ic), 1) !dab1(il,ic) + + IF ( .false. .and. ny <= 2 ) THEN + write(0,*) + write(0,*) 'bb: ', bb(il), bb(ic), xnutmp, xnuc, xmu(il), xmu(ic) + write(0,*) 'il,ic = ',il,ic,alpha(mgs,il),i,xnuc,alp,j + write(0,*) 'dab0lh,tmp1 = ',dab0lh(mgs,ic,il),tmp1 + write(0,*) 'dab1lh,tmp2 = ',dab1lh(mgs,ic,il),tmp2 + write(0,*) 'dab0lh,tmp3 = ',dab0lh(mgs,il,ic),tmp3,tmp5 + write(0,*) 'dab1lh,tmp4 = ',dab1lh(mgs,il,ic),tmp4,tmp6 + + ENDIF + + ENDIF + + ENDIF + ENDDO + +! ENDIF + + da0lx(mgs,il) = delbk(bb(il), xnutmp, xmu(il), 0) + IF ( il .eq. lh ) THEN + da0lh(mgs) = delbk(bb(il), xnutmp, xmu(il), 0) + IF ( lzr > 1 ) THEN + rzxh(mgs) = 1. + ELSE + rzxh(mgs) = ((4. + alpha(mgs,il))*(5. + alpha(mgs,il))*(6. + alpha(mgs,il))*(1. + xnu(lr)))/ & + & ((1. + alpha(mgs,il))*(2. + alpha(mgs,il))*(3. + alpha(mgs,il))*(2. + xnu(lr))) + ENDIF + + IF ( lzhl < 1 ) THEN + rzxhlh(mgs) = rzxhl(mgs)/(((4. + alpha(mgs,il))*(5. + alpha(mgs,il))*(6. + alpha(mgs,il))*(1. + xnu(lr)))/ & + & ((1. + alpha(mgs,il))*(2. + alpha(mgs,il))*(3. + alpha(mgs,il))*(2. + xnu(lr)))) + ENDIF + ELSEIF ( il .eq. lhl ) THEN + da0lhl(mgs) = delbk(bb(il), xnutmp, xmu(il), 0) + IF ( lzr > 1 ) THEN + rzxhl(mgs) = 1. + ELSE + rzxhl(mgs) = ((4.0 + alpha(mgs,il))*(5. + alpha(mgs,il))*(6. + alpha(mgs,il))*(1. + xnu(lr)))/ & + & ((1. + alpha(mgs,il))*(2. + alpha(mgs,il))*(3. + alpha(mgs,il))*(2. + xnu(lr))) + ENDIF + ELSEIF ( il == lr ) THEN + xnutmp = (alpha(mgs,il) - 2.)/3. + da0lr(mgs) = delbk(bb(il), xnutmp, xmu(il), 0) + da1lr(mgs) = delbk(bb(il), xnutmp, xmu(il), 1) + ENDIF + + ENDIF ! ( qx(mgs,il) > qxmin(il) ) + ENDDO ! mgs +! CALL cld_cpu('Z-DELABK') + ENDIF ! il /= lr + +! CALL cld_cpu('Z-DELABK') + + ENDIF ! lz(il) .gt. 1 + + ENDDO ! il + + ENDIF ! ipconc .ge. 6 + +! CALL cld_cpu('Z-MOMENT-1') ! ! set some values for ice nucleation @@ -12044,7 +15123,7 @@ subroutine nssl_2mom_gs & ! & itype1a,itype2a,temcg,infdo,alpha) - infdo = 0 + infdo = 1 IF ( rimdenvwgt > 0 ) infdo = 1 call setvtz(ngscnt,qx,qxmin,qxw,cx,rho0,rhovt,xdia,cno,cnostmp, & @@ -12058,9 +15137,9 @@ subroutine nssl_2mom_gs & IF ( lwsm6 .and. ipconc == 0 ) THEN tmp = Max(qxmin(lh), qxmin(ls)) DO mgs = 1,ngscnt - sum = qx(mgs,lh) + qx(mgs,ls) - IF ( sum > tmp ) THEN - vt2ave(mgs) = (qx(mgs,lh)*vtxbar(mgs,lh,1) + qx(mgs,ls)*vtxbar(mgs,ls,1))/sum + total = qx(mgs,lh) + qx(mgs,ls) + IF ( total > tmp ) THEN + vt2ave(mgs) = (qx(mgs,lh)*vtxbar(mgs,lh,1) + qx(mgs,ls)*vtxbar(mgs,ls,1))/total ELSE vt2ave(mgs) = 0.0 ENDIF @@ -12206,6 +15285,17 @@ subroutine nssl_2mom_gs & + IF ( ipconc >= 6 ) THEN + frac = 0.4d0 + zxmxd(:,:) = 0.0 + DO il = lr,lhab + IF ( lz(il) > 0 .or. ( il == lr ) ) THEN + DO mgs = 1,ngscnt + zxmxd(mgs,il) = frac*zx(mgs,il)*dtpinv + ENDDO + ENDIF + ENDDO + ENDIF @@ -12243,10 +15333,10 @@ subroutine nssl_2mom_gs & vshdgs(mgs,il) = vshd ! base value - IF ( qx(mgs,il) > qxmin(il) ) THEN + IF ( qx(mgs,il) > qxmin(il) .and. ivshdgs > 0 ) THEN ! tmpdiam is weighted diameter of d^(shedalp-1), so for shedalp=3, this is the area-weighted diameter or maximum mass diameter. - tmpdiam = (shedalp+alpha(mgs,il))*xdia(mgs,il,1)*( xdn(mgs,il)/917. )**(1./3.) ! erm added density factor for equiv. solid ice sphere 10.12.2015 + tmpdiam = (shedalp+alpha(mgs,il))*xdia(mgs,il,1) ! *( xdn(mgs,il)/917. )**(1./3.) ! erm added density factor for equiv. solid ice sphere 10.12.2015 IF ( tmpdiam > sheddiam0 ) THEN vshdgs(mgs,il) = 0.523599*(1.5e-3)**3/massfacshr ! 1.5mm drops from very large ice @@ -12303,13 +15393,13 @@ subroutine nssl_2mom_gs & ers(mgs) = 0.0 ess(mgs) = 0.0 ehs(mgs) = 0.0 ! used as sticking efficiency, so collection efficiency is ehs*ehsclsn + ehsfac(mgs) = 1.0 ! factor based on ice saturation ehls(mgs) = 0.0 ! used as sticking efficiency, so collection efficiency is ehls*ehlsclsn ehscnv(mgs) = 0.0 ! ehxs(mgs) = 0.0 ! eiw(mgs) = 0.0 eii(mgs) = 0.0 - ehsclsn(mgs) = 0.0 ehiclsn(mgs) = 0.0 ehlsclsn(mgs) = 0.0 @@ -12404,7 +15494,7 @@ subroutine nssl_2mom_gs & if ( qx(mgs,li).gt.qxmin(li) .and. qx(mgs,lc).gt.qxmin(lc) ) then - if (xdia(mgs,lc,1).gt.15.0e-06 .and. xdia(mgs,li,1).gt.30.0e-06) then + if (xdia(mgs,lc,1).gt.ewi_dcmin .and. xdia(mgs,li,1).gt.ewi_dimin) then ! erm 5/10/2007 test following change: ! if (xdia(mgs,lc,1).gt.12.0e-06 .and. xdia(mgs,li,1).gt.50.0e-06) then eiw(mgs) = 0.5 @@ -12528,7 +15618,7 @@ subroutine nssl_2mom_gs & ELSE fac = Abs(ess0) - IF ( .true. .and. ess0 < 0.0 ) THEN + IF ( iessopt == 2 ) THEN ! experimental code ! IF ( wvel(mgs) > 2.0 .or. wvel(mgs) < -0.5 .or. ssi(mgs) < 1.0 ) THEN IF ( wvel(mgs) > 2.0 ) THEN ! assume convective cell or downdraft @@ -12536,9 +15626,25 @@ subroutine nssl_2mom_gs & ELSEIF ( wvel(mgs) > 1.0 ) THEN ! transition to stratiform range of values fac = Max(0.0, 2.0 - wvel(mgs))*fac ENDIF + ELSEIF ( iessopt == 3 ) THEN ! factor based on ice supersat + IF ( ssi(mgs) <= 1.0 ) THEN + fac = 0.0 + ehsfac(mgs) = 0.0 + ELSEIF ( ssi(mgs) <= 1.02 ) THEN + fac = fac*(ssi(mgs) - 1.0)/0.02 + ehsfac(mgs) = (ssi(mgs) - 1.0)/0.02 + ENDIF + ELSEIF ( iessopt == 4 ) THEN ! factor based on ice supersat; very roughly based on Hosler et al. 1957 (J. Met.) + IF ( ssi(mgs) <= 1.0 ) THEN + fac = 0.1 + ehsfac(mgs) = 0.1 + ELSEIF ( ssi(mgs) <= 1.005 ) THEN + fac = Max(0.1, fac*(ssi(mgs) - 1.0)/0.005) + ehsfac(mgs) = Max(0.1, (ssi(mgs) - 1.0)/0.005) + ENDIF ENDIF - IF ( temcg(mgs) > esstem1 .and. temcg(mgs) < esstem2 ) THEN ! only nonzero for T > -25 + IF ( temcg(mgs) > esstem1 .and. temcg(mgs) < esstem2 ) THEN ! only nonzero for T > esstem1 ess(mgs) = fac*Exp(ess1*(esstem2) )*(temcg(mgs) - esstem1)/(esstem2 - esstem1) ! linear ramp up from zero at esstem1 to value at esstem2 ELSEIF ( temcg(mgs) >= esstem2 ) THEN ess(mgs) = fac*Exp(ess1*Min( temcg(mgs), 0.0 ) ) @@ -12649,7 +15755,11 @@ subroutine nssl_2mom_gs & ELSE ehscnv(mgs) = exp(0.09*min(temcg(mgs),0.0)) ENDIF - if ( qx(mgs,lh).gt.qxmin(lh) .and. qx(mgs,lc) > qxmin(lc) ) then + + IF ( qx(mgs,lh).gt.qxmin(lh) .and. qx(mgs,lc) >= qxmin(lc) ) THEN +! ehsclsn(mgs) = ehs_collsn +! ehs(mgs) = ehscnv(mgs)*ehsfac(mgs)*Min(1.0, Max(0.0,xdn(mgs,lh) - 300.)/300. ) +! ELSEIF ( qx(mgs,lh).gt.qxmin(lh) .and. qx(mgs,lc) >= qxmin(lc) ) then ehsclsn(mgs) = ehs_collsn IF ( xdia(mgs,ls,3) < 40.e-6 ) THEN ehsclsn(mgs) = 0.0 @@ -12659,9 +15769,9 @@ subroutine nssl_2mom_gs & ehsclsn(mgs) = ehs_collsn ENDIF ! ehs(mgs) = ehscnv(mgs)*Min(1.0, Max(0., xdn(mgs,lh) - xdnmn(lh)*1.2)/xdnmn(lh) ) ! shut off qhacs as graupel goes to lowest density - ehs(mgs) = ehscnv(mgs)*Min(1.0, Max(0.0,xdn(mgs,lh) - 300.)/300. ) ! shut off qhacs as graupel goes to low density + ehs(mgs) = ehscnv(mgs)*Min(1.0, Max(0.0,xdn(mgs,lh) - 300.)/300. ) ! shut off qhacs as graupel goes to low density; limits scavenging of snow in bright band +! ehs(mgs) = ehscnv(mgs) ! *Min(1.0, Max(0.0,xdn(mgs,lh) - 300.)/300. ) ! shut off qhacs as graupel goes to low density ehs(mgs) = Min(ehs(mgs),ehsmax) - IF ( qx(mgs,lc) < qxmin(lc) ) ehs(mgs) = 0.0 end if ENDIF ! @@ -12669,7 +15779,7 @@ subroutine nssl_2mom_gs & ehiclsn(mgs) = ehi_collsn ehi(mgs)=eii0*exp(eii1*min(temcg(mgs),0.0)) ehi(mgs) = Min( ehimax, Max( ehi(mgs), ehimin ) ) - if ( temg(mgs) .gt. 273.15 .or. ( qx(mgs,lc) < qxmin(lc)) ) ehi(mgs) = 0.0 +! if ( temg(mgs) .gt. 273.15 .or. ( qx(mgs,lc) < qxmin(lc)) ) ehi(mgs) = 0.0 end if IF ( lis > 1 ) THEN @@ -12677,7 +15787,7 @@ subroutine nssl_2mom_gs & ehisclsn(mgs) = ehi_collsn ehis(mgs)=eii0*exp(eii1*min(temcg(mgs),0.0)) ehis(mgs) = Min( ehimax, Max( ehis(mgs), ehimin ) ) - if ( temg(mgs) .gt. 273.15 .or. ( qx(mgs,lc) < qxmin(lc)) ) ehis(mgs) = 0.0 +! if ( temg(mgs) .gt. 273.15 .or. ( qx(mgs,lc) < qxmin(lc)) ) ehis(mgs) = 0.0 end if ENDIF @@ -12814,6 +15924,7 @@ subroutine nssl_2mom_gs & end do + ! ! ! @@ -12887,6 +15998,7 @@ subroutine nssl_2mom_gs & do mgs = 1,ngscnt qraci(mgs) = 0.0 craci(mgs) = 0.0 + qracs(mgs) = 0.0 IF ( eri(mgs) .gt. 0.0 .and. iacr .ge. 1 .and. xdia(mgs,lr,3) .gt. 2.*rwradmn ) THEN IF ( ipconc .ge. 3 ) THEN @@ -12932,8 +16044,9 @@ subroutine nssl_2mom_gs & ENDIF end do ! + IF ( ipconc < 3 ) THEN do mgs = 1,ngscnt - qracs(mgs) = 0.0 + qracs(mgs) = 0.0 IF ( ers(mgs) .gt. 0.0 .and. ipconc < 3 ) THEN IF ( lwsm6 .and. ipconc == 0 ) THEN vt = vt2ave(mgs) @@ -12950,6 +16063,7 @@ subroutine nssl_2mom_gs & & , qsmxd(mgs)) ENDIF end do + ENDIF ! ! @@ -13096,6 +16210,7 @@ subroutine nssl_2mom_gs & ! do mgs = 1,ngscnt qhacw(mgs) = 0.0 + qhacwmlr(mgs) = 0.0 rarx(mgs,lh) = 0.0 vhacw(mgs) = 0.0 vhsoak(mgs) = 0.0 @@ -13162,6 +16277,11 @@ subroutine nssl_2mom_gs & ENDIF + qhacwmlr(mgs) = qhacw(mgs) + IF ( temg(mgs) > tfr .and. iqhacwshr == 0 ) THEN + qhacw(mgs) = 0.0 + ENDIF + IF ( lvol(lh) .gt. 1 .or. lhl .gt. 1 ) THEN ! calculate rime density for graupel volume and/or for graupel conversion to hail IF ( temg(mgs) .lt. 273.15) THEN @@ -13191,14 +16311,18 @@ subroutine nssl_2mom_gs & rimdn(mgs,lh) = 1000.*(0.051 + 0.114*tmp - 0.0055*tmp**2) - ELSEIF ( irimdenopt == 3 ) THEN ! Macklin + ELSEIF ( irimdenopt == 3 .or. irimdenopt == 4) THEN ! Macklin (3) or Saunders and Hosseini 2001 tmp = (-((0.5)*(1.e+06)*xdia(mgs,lc,1)) & & *( (1.0-rimdenvwgt)*vtxbar(mgs,lh,1) + rimdenvwgt*vtxbar(mgs,lh,2) ) & & /(temg(mgs)-273.15)) ! tmp = Min( 5.5/0.6, Max( 0.3/0.6, tmp ) ) - rimdn(mgs,lh) = Min(900., Max( 170., 110.*tmp**0.76 ) ) + IF ( irimdenopt == 3 ) THEN + rimdn(mgs,lh) = Min(900., Max( 170., 110.*tmp**0.76 ) ) + ELSEIF ( irimdenopt == 4 ) THEN ! Saunders and Hosseini + rimdn(mgs,lh) = Min(917., Max( 10., 900.0*(1.0 - 0.905**tmp ) ) ) + ENDIF ENDIF ELSE @@ -13412,6 +16536,7 @@ subroutine nssl_2mom_gs & do mgs = 1,ngscnt qhlacw(mgs) = 0.0 + qhlacwmlr(mgs) = 0.0 vhlacw(mgs) = 0.0 vhlsoak(mgs) = 0.0 IF ( lhl > 1 .and. .true.) THEN @@ -13440,10 +16565,15 @@ subroutine nssl_2mom_gs & qhlacw(mgs) = Min( qhlacw(mgs), 0.5*qx(mgs,lc)*dtpinv ) + qhlacwmlr(mgs) = qhlacw(mgs) + IF ( temg(mgs) > tfr .and. iqhlacwshr == 0 ) THEN + qhlacw(mgs) = 0.0 + ENDIF + IF ( lvol(lhl) .gt. 1 ) THEN IF ( temg(mgs) .lt. 273.15) THEN - IF ( irimdenopt == 1 ) THEN ! Rasmussen and Heymsfeld (1985) + IF ( irimdenopt == 1 ) THEN ! Heymsfeld and Pflaum (1985) rimdn(mgs,lhl) = rimc1*(-((0.5)*(1.e+06)*xdia(mgs,lc,1)) & & *((0.60)*( (1.0-rimdenvwgt)*vtxbar(mgs,lhl,1) + rimdenvwgt*vtxbar(mgs,lhl,2) )) & & /(temg(mgs)-273.15))**(rimc2) @@ -13457,13 +16587,17 @@ subroutine nssl_2mom_gs & rimdn(mgs,lhl) = 1000.*(0.051 + 0.114*tmp - 0.005*tmp**2) - ELSEIF ( irimdenopt == 3 ) THEN ! Macklin + ELSEIF ( irimdenopt == 3 .or. irimdenopt == 4) THEN ! Macklin (3) or Saunders and Hosseini 2001 tmp = -0.5*(1.e+06)*xdia(mgs,lc,1) & & *( (1.0-rimdenvwgt)*vtxbar(mgs,lhl,1) + rimdenvwgt*vtxbar(mgs,lhl,2) ) & & /(temg(mgs)-273.15) ! tmp = Min( 5.5/0.6, Max( 0.3/0.6, tmp ) ) - rimdn(mgs,lhl) = Min(900., Max( 170., 110.*tmp**0.76 ) ) + IF ( irimdenopt == 3 ) THEN + rimdn(mgs,lhl) = Min(900., Max( 170., 110.*tmp**0.76 ) ) + ELSEIF ( irimdenopt == 4 ) THEN ! Saunders and Hosseini + rimdn(mgs,lhl) = Min(917., Max( 10., 900.0*(1.0 - 0.905**tmp ) ) ) + ENDIF ENDIF ELSE @@ -13778,7 +16912,7 @@ subroutine nssl_2mom_gs & frach = 0.5 *(1. + Tanh(0.2e12 *( xvfrz - 1.15*xvbiggsnow))) qiacrs(mgs) = (1.-frach)*qiacr(mgs) - ciacrs(mgs) = (1.-frach)*ciacr(mgs) ! *rzxh(mgs) + ciacrs(mgs) = (1.-frach)*ciacrf(mgs) ! *rzxh(mgs) ENDIF ENDIF @@ -13808,7 +16942,7 @@ subroutine nssl_2mom_gs & tmp = xv(mgs,ls)/(xvmx(ls)*Max(1.,100./Min(100.,xdn(mgs,ls)))) ! fraction of max snow mass IF ( tmp .lt. essfrac1 ) THEN ec0(mgs) = 1.0 - ELSEIF ( tmp .gt. essfrac2 ) THEN + ELSEIF ( tmp .ge. essfrac2 ) THEN ec0(mgs) = 0.0 ELSE ec0(mgs) = (essfrac2 - tmp)/(essfrac2 - essfrac1) @@ -13885,7 +17019,21 @@ subroutine nssl_2mom_gs & ec0(mgs) = 2.e9 IF ( qx(mgs,lr) .gt. qxmin(lr) ) THEN rwrad = 0.5*xdia(mgs,lr,3) - IF ( xdia(mgs,lr,3) .gt. 2.0e-3 .or. icracr <= 0 ) THEN + + + ! check median volume diameter + IF ( icracrthresh > 1 ) THEN + IF ( imurain == 1 ) THEN + tmp = (3.67+alpha(mgs,lr))*xdia(mgs,lr,1) ! median volume diameter; units of mm (Ulbrich 1983, JCAM) + ELSE ! imurain == 3, + tmp = (1.678+alpha(mgs,lr))**(1./3.)*xdia(mgs,lr,1) ! units of mm (using method of Ulbrich 1983. See ventillation_stuff.nb) + ENDIF + ELSE + tmp = xdia(mgs,lr,3) - 0.1e-3 + ENDIF + +! IF ( xdia(mgs,lr,3) .gt. 2.0e-3 .or. icracr <= 0 ) THEN + IF ( tmp .gt. 1.9e-3 .or. icracr <= 0 ) THEN ec0(mgs) = 0.0 cracr(mgs) = 0.0 ELSE @@ -13967,6 +17115,7 @@ subroutine nssl_2mom_gs & ! if (ndebug .gt. 0 ) write(0,*) 'ICEZVD_GS: conc 22kk' chaci(:) = 0.0 + chaci0(:) = 0.0 if ( ipconc .ge. 1 .or. ipelec .ge. 1 ) then do mgs = 1,ngscnt IF ( ehi(mgs) .gt. 0.0 .or. ( ehiclsn(mgs) > 0.0 .and. ipelec > 0 )) THEN @@ -14017,6 +17166,7 @@ subroutine nssl_2mom_gs & ! if (ndebug .gt. 0 ) write(0,*) 'ICEZVD_GS: conc 22nn' chacs(:) = 0.0 + chacs0(:) = 0.0 if ( ipconc .ge. 1 .or. ipelec .ge. 1 ) then do mgs = 1,ngscnt IF ( ehs(mgs) .gt. 0 ) THEN @@ -14176,7 +17326,7 @@ subroutine nssl_2mom_gs & ! Ziegler (1985) autoconversion ! ! - IF ( ipconc .ge. 2 .and. ircnw /= -1) THEN ! DTD: added flag for autoconversion. If -1, turns off autoconversion + IF ( ipconc .ge. 2 ) THEN if (ndebug .gt. 0 ) write(0,*) 'conc 26a' DO mgs = 1,ngscnt @@ -14196,7 +17346,7 @@ subroutine nssl_2mom_gs & cautn(mgs) = Min(ccmxd(mgs), & & ((alpha(mgs,lc)+2.)/(alpha(mgs,lc)+1.))*aa1*cx(mgs,lc)**2*xv(mgs,lc)**2) cautn(mgs) = Max( 0.0d0, cautn(mgs) ) - IF ( rb(mgs) .le. 7.51d-6 ) THEN + IF ( rb(mgs) .le. 7.51d-6 .or. dmrauto == -1) THEN t2s = 1.d30 ! cautn(mgs) = 0.0 ELSE @@ -14259,6 +17409,47 @@ subroutine nssl_2mom_gs & IF ( crcnw(mgs) < 1.e-30 ) qrcnw(mgs) = 0.0 + IF ( ipconc >= 6 ) THEN + IF ( lzr > 1 .and. qrcnw(mgs) > 0.0 ) THEN +! vr = rho0(mgs)*qrcnw(mgs)/(1000.*crcnw(mgs)) +! zrcnw(mgs) = 36.*(xnu(lr)+2.0)*crcnw(mgs)*vr**2/((xnu(lr)+1.0)*pi**2) + ! DTD: If rain exists at a grid point already either use the alpha-preserving Z-rate eqn. (dmrauto == 1) + ! or a mass-weighted average of the alpha-preserving Z-rate eqn. and the init. rate eqn. (dmrauto == 2) + ! or the original initiation rate equation (dmrauto == 0). Not sure if this is the correct way to go but seems to work ok. + IF (qx(mgs,lr) .gt. qxmin(lr) .and. ( dmrauto == 1 .or. dmrauto ==2 ) ) THEN + tmp3 = qx(mgs,lr)/cx(mgs,lr) + tmp4 = g1x(mgs,lr)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2* & + & ( 2.*tmp3 * qrcnw(mgs) - tmp3**2 * crcnw(mgs) ) + if (imurain == 3) then + vr = rho0(mgs)*qrcnw(mgs)/(1000.) + tmp3 = 36.*(xnu(lc)+2.0)*vr**2/(crcnw(mgs)*(xnu(lc)+1.0)*pi**2) + else + tmp3 = galpharaut*(6.*rho0(mgs)*qrcnw(mgs)/(pi*xdn0(lr)))**2/crcnw(mgs) + endif + IF ( dmrauto == 1 ) THEN ! Preserve alpha + zrcnw(mgs) = tmp4 + ELSEIF ( dmrauto == 2 ) THEN ! Mass-weighted average + zrcnw(mgs) = (tmp3*qrcnw(mgs)+tmp4*qx(mgs,lr))/(qrcnw(mgs)+qx(mgs,lr)) + ENDIF + else ! original formulation + IF ( imurain == 3 ) THEN + vr = rho0(mgs)*qrcnw(mgs)/(1000.) ! crcnw(mgs) not divided here but is in next line, cancels one factor in the numerator + zrcnw(mgs) = 36.*(xnu(lc)+2.0)*vr**2/(crcnw(mgs)*(xnu(lc)+1.0)*pi**2) + ELSE ! rain in gamma of diameter + IF ( dmropt <= 1 .or. dmropt >= 4 .or. ( qx(mgs,lr) < qxmin(lr) .and. cx(mgs,lr) < cxmin ) ) THEN + zrcnw(mgs) = galpharaut*(6.*rho0(mgs)*qrcnw(mgs)/(pi*xdn0(lr)))**2/crcnw(mgs) + ELSE + tmp3 = qx(mgs,lr)/cx(mgs,lr) + zrcnw(mgs) = g1x(mgs,lr)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2* & + & ( 2.*tmp3 * qrcnw(mgs) - tmp3**2 * crcnw(mgs) ) + ENDIF +! vr = rho0(mgs)*qrcnw(mgs)/(1000.) ! crcnw(mgs) not divided here but is in next line, cancels one factor in the numerator +! zrcnw(mgs) = 36.*(xnu(lc)+2.0)*vr**2/(crcnw(mgs)*(xnu(lc)+1.0)*pi**2) + ENDIF + endif +! z = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/((alpha(mgs,lr)+1.0)*pi**2) + ENDIF + ENDIF ! ipconc >= 6 ! IF ( crcnw(mgs) .gt. cautn(mgs) .and. crcnw(mgs) .gt. 1.0 ) ! : THEN ! write(0,*) 'crcnw,cautn ',crcnw(mgs)/cautn(mgs), @@ -14469,6 +17660,15 @@ subroutine nssl_2mom_gs & ELSE !{ + IF ( ipconc >= 6 .and. lzr > 1 ) THEN + ! interpolate along x, i.e., ratio; + tmp1 = ziacrratio(i,j) + delx*dqiacrratioinv*(ziacrratio(ip1,j) - ziacrratio(i,j)) + tmp2 = ziacrratio(i,jp1) + delx*dqiacrratioinv*(ziacrratio(ip1,jp1) - ziacrratio(i,jp1)) + + ! interpolate along alpha; + + zrfrz(mgs) = (tmp1 + dely*dqiacralphainv*(tmp2 - tmp1))*zx(mgs,lr)*dtpinv + ENDIF IF ( ibiggsmallrain > 0 .and. xv(mgs,lr) < 2.*xvmn(lr) .and. ( ibiggsnow == 1 .or. ibiggsnow == 3 ) ) THEN ! IF ( ibiggsmallrain > 0 .and. xv(mgs,lr) < xvbiggsnow .and. ( ibiggsnow == 1 .or. ibiggsnow == 3 ) ) THEN @@ -14478,6 +17678,10 @@ subroutine nssl_2mom_gs & crfrzs(mgs) = crfrz(mgs) qrfrzs(mgs) = qrfrz(mgs) + IF ( ipconc >= 6 .and. lzr > 1 ) THEN + zrfrzs(mgs) = zrfrz(mgs) + zrfrzf(mgs) = 0. + ENDIF ELSEIF ( dbigg < Max( biggsnowdiam, Max(dfrz,dhmn)) .and. ( ibiggsnow == 1 .or. ibiggsnow == 3 ) ) THEN ! { convert some to snow or ice crystals ! temporarily store qrfrz and crfrz in snow terms and caclulate new crfrzf, qrfrzf, and zrfrzf. Leave crfrz etc. alone! @@ -14489,6 +17693,10 @@ subroutine nssl_2mom_gs & crfrzf(mgs) = 0.0 qrfrzf(mgs) = 0.0 + IF (ipconc >= 6 .and. lzr > 1 ) THEN + zrfrzs(mgs) = zrfrz(mgs) + zrfrzf(mgs) = 0. + ENDIF ELSE !{ ! recalculate using dhmn for ratio @@ -14528,10 +17736,23 @@ subroutine nssl_2mom_gs & crfrzs(mgs) = crfrzs(mgs) - crfrzf(mgs) qrfrzs(mgs) = qrfrzs(mgs) - qrfrzf(mgs) + IF ( ipconc >= 6 .and. lzr > 1 ) THEN + zrfrzs(mgs) = zrfrz(mgs) + ! interpolate along x, i.e., ratio; + tmp1 = ziacrratio(i,j) + delx*dqiacrratioinv*(ziacrratio(ip1,j) - ziacrratio(i,j)) + tmp2 = ziacrratio(i,jp1) + delx*dqiacrratioinv*(ziacrratio(ip1,jp1) - ziacrratio(i,jp1)) + + ! interpolate along alpha; + + zrfrzf(mgs) = (tmp1 + dely*dqiacralphainv*(tmp2 - tmp1))*zx(mgs,lr)*dtpinv + zrfrzs(mgs) = zrfrzs(mgs) - zrfrzf(mgs) + zrfrzf(mgs) = (1000./900.)**2*zrfrzf(mgs) + ENDIF ENDIF ! } ELSE crfrzs(mgs) = 0.0 qrfrzs(mgs) = 0.0 + zrfrzs(mgs) = 0.0 ENDIF ! } ENDIF !} @@ -14544,6 +17765,10 @@ subroutine nssl_2mom_gs & crfrz(mgs) = fac*crfrz(mgs) crfrzs(mgs) = fac*crfrzs(mgs) crfrzf(mgs) = fac*crfrzf(mgs) + IF ( ipconc >= 6 .and. lzr > 1 ) THEN + zrfrz(mgs) = fac*zrfrz(mgs) + zrfrzf(mgs) = fac*zrfrzf(mgs) + ENDIF ENDIF ENDIF !} @@ -15088,8 +18313,16 @@ subroutine nssl_2mom_gs & x = 1. + alpha(mgs,lr) - IF ( lzr > 1 ) THEN ! 3 moment -! + IF ( ipconc >= 6 .and. lzr > 1 ) THEN ! 3 moment + tmp = 1. + alpr ! alpha(mgs,lr) + i = Int(dgami*(tmp)) + del = tmp - dgam*i + g1palp = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + + tmp = 2.5 + alpha(mgs,lr) + 0.5*bx(lr) + i = Int(dgami*(tmp)) + del = tmp - dgam*i + y = (gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami)/g1palp ! ratio of gamma functions ELSE y = ventrxn(mgs) ENDIF @@ -15105,6 +18338,13 @@ subroutine nssl_2mom_gs & & 0.308*fvent(mgs)*y* & & Sqrt(ax(lr)*rhovt(mgs))*(vent1/vent2) + rwventz(mgs) = 0.0 + +! rwventz(mgs) = & +! & 0.78*x + & +! & 0.308*fvent(mgs)*y* & +! & Sqrt(ax(lr)*rhovt(mgs))*(vent1/vent2) + ELSEIF ( iferwisventr == 2 ) THEN @@ -15117,6 +18357,23 @@ subroutine nssl_2mom_gs & & *(xdia(mgs,lr,1)**((1.0+br)/2.0)) ) + IF ( ipconc >= 7 ) THEN + alpr = Min(alpharmax,alpha(mgs,lr) ) + + tmp = alpr + 5.5 + br/2. + i = Int(dgami*(tmp)) + del = tmp - dgam*i + y = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + +! rwventz(mgs) = & +! & 0.78*(4. + alpha(mgs,lr))*(3. + alpha(mgs,lr))*(2. + alpha(mgs,lr))*(1. + alpha(mgs,lr)) + & + rwventz(mgs) = & + & 0.78*(4. + alpr)*(3. + alpr)*(2. + alpr)*(1. + alpr) + & + & 0.308*fvent(mgs)* & + & Sqrt(ax(lr)*rhovt(mgs))*(y/gf1palp(mgs))*(xdia(mgs,lr,1)**((1.0+br)/2.0)) + + ENDIF + ENDIF ! iferwisventr @@ -15159,6 +18416,9 @@ subroutine nssl_2mom_gs & hwventa = (0.78)*gmoi(igmhwa) hwventb = (0.308)*gmoi(igmhwb) ! hwventc = (4.0*gr/(3.0*cdx(lh)))**(0.25) + hwvent(:) = 0.0 + hwventy(:) = 0.0 + do mgs = 1,ngscnt IF ( qx(mgs,lh) .gt. qxmin(lh) ) THEN hwventc = (4.0*gr/(3.0*cdxgs(mgs,lh)))**(0.25) @@ -15279,6 +18539,8 @@ subroutine nssl_2mom_gs & & -ftka(mgs)*temcg(mgs)/rho0(mgs) ) & & / (felf(mgs)) fmlt2(mgs) = -fcw(mgs)*temcg(mgs)/felf(mgs) + fmlt1e(mgs) = (2.0*pi)* & + & ( felv(mgs)*fwvdf(mgs)*(qss0(mgs)-qx(mgs,lv)) ) / (felf(mgs)) end do ! ! Vapor Deposition constants @@ -15306,6 +18568,7 @@ subroutine nssl_2mom_gs & qhlmlrlg(:) = 0.0 ENDIF qhfzh(:) = 0.0 + qffzf(:) = 0.0 qhlfzhl(:) = 0.0 qhfzhlg(:) = 0.0 qhlfzhllg(:) = 0.0 @@ -15313,9 +18576,10 @@ subroutine nssl_2mom_gs & vffzf(:) = 0.0 vhlfzhl(:) = 0.0 qsfzs(:) = 0.0 - zsmlr(:) = 0.0 +! zsmlr(:) = 0.0 zhmlr(:) = 0.0 zhmlrr(:) = 0.0 + zsmlrr(:) = 0.0 zhshr(:) = 0.0 zhlmlr(:) = 0.0 zhlshr(:) = 0.0 @@ -15329,6 +18593,7 @@ subroutine nssl_2mom_gs & chmlr(:) = 0.0 chmlrr(:) = 0.0 chlmlr(:) = 0.0 + chlfmlr(:) = 0.0 ! chlmlrsave(:) = 0.0 ! qhlmlrsave(:) = 0.0 ! chlsave(:) = 0.0 @@ -15366,7 +18631,7 @@ subroutine nssl_2mom_gs & qhmlr(mgs) = & & meltfac*min( & & fmlt1(mgs)*cx(mgs,lh)*hwvent(mgs)*xdia(mgs,lh,1) & - & + fmlt2(mgs)*(qhacrmlr(mgs)+qhacw(mgs)) & + & + fmlt2(mgs)*(qhacrmlr(mgs)+qhacwmlr(mgs)) & & , 0.0 ) ELSEIF ( ibinhmlr == 1 ) THEN ! use incomplete gamma functions to approximate the bin results @@ -15397,13 +18662,13 @@ subroutine nssl_2mom_gs & qhlmlr(mgs) = & & meltfac*min( & & fmlt1(mgs)*cx(mgs,lhl)*hlvent(mgs)*xdia(mgs,lhl,1) & - & + fmlt2(mgs)*(qhlacrmlr(mgs)+qhlacw(mgs)) & + & + fmlt2(mgs)*(qhlacrmlr(mgs)+qhlacwmlr(mgs)) & & , 0.0 ) ELSEIF ( ibinhlmlr == 1 ) THEN ! use incomplete gamma functions to approximate the bin results -! #ifdef Z3MOM -! #if (defined Z3MOM) && defined( COMMAS ) || defined( COMMASTMP ) +! #ifdef 1 +! #if (defined 1) && defined( COMMAS ) || defined( COMMASTMP ) ELSEIF ( ibinhlmlr == -1 ) THEN ! OLD VERSION use incomplete gamma functions to approximate the bin results @@ -15434,7 +18699,7 @@ subroutine nssl_2mom_gs & chmlr(mgs) = max( chmlr(mgs), Min( -chmxd(mgs), -0.95*cx(mgs,lh)*dtpinv ) ) ENDIF ! qhmlr(mgs) = max( max( qhmlr(mgs), -qhmxd(mgs) ) , -0.5*qx(mgs,lh)*dtpinv ) !limits to 1/2 qh or max depletion - qhmlh(mgs) = 0. + qhmlh(mgs) = 0. ! not used ! Rasmussen and Heymsfield say melt water remains on graupel up to 9 mm before shedding @@ -15511,8 +18776,15 @@ subroutine nssl_2mom_gs & ! ENDIF - IF ( chmlr(mgs) < 0.0 .and. (ibinhmlr < 1 .or. lzh < 1) ) THEN ! { already done if ibinhmlr > 0 + IF ( ipconc >= 6 .and. lzr .gt. 1 .and. lzh < 1 .and. qx(mgs,lh) > qxmin(lh) ) THEN ! Only compute if rain is 3-moment but graupel is not, otherwise is computed later + tmp = qx(mgs,lh)/cx(mgs,lh) + alp = alpha(mgs,lh) + g1 = g1x(mgs,lh) ! (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + + zhmlr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*tmp * qhmlr(mgs) - tmp**2 * chmlr(mgs) ) + + ENDIF IF ( ibinhmlr == 0 .or. lzh < 1 ) THEN IF ( ihmlt .eq. 1 ) THEN @@ -15618,6 +18890,17 @@ subroutine nssl_2mom_gs & ENDIF !} + IF ( ipconc >= 8 .and. lzhl .gt. 1 .and. ibinhlmlr <= 0 ) THEN + IF ( cx(mgs,lhl) > 0.0 ) THEN + + tmp = qx(mgs,lhl)/cx(mgs,lhl) + alp = alpha(mgs,lhl) +! g1 = (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + g1 = g1x(mgs,lhl) ! (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + + zhlmlr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lhl)))**2*( tmp * qhlmlr(mgs) ) + ENDIF + ENDIF ENDIF ! } ENDIF ! }.not. mixedphase @@ -15655,6 +18938,7 @@ subroutine nssl_2mom_gs & ENDDO ! ! + qhdsv(:) = 0.0 qhldsv(:) = 0.0 do mgs = 1,ngscnt @@ -15664,6 +18948,7 @@ subroutine nssl_2mom_gs & & fvds(mgs)*cx(mgs,li)*civent(mgs)*cicap(mgs)*depfac qsdsv(mgs) = & & fvds(mgs)*cx(mgs,ls)*swvent(mgs)*swcap(mgs)*depfac + ! IF ( ny .eq. 2 .and. igs(mgs) .eq. 302 .and. temg(mgs) .le. tfrh+10 .and. qx(mgs,lv) .gt. qis(mgs) ! : .and. qx(mgs,li) .gt. qxmin(li) ) THEN ! write(0,*) 'qidsv = ',nstep,kgs(mgs),qidsv(mgs),temg(mgs)-tfrh,100.*(qx(mgs,lv)/qis(mgs) - 1.),1.e6*xdia(mgs,li,1), @@ -15900,20 +19185,41 @@ subroutine nssl_2mom_gs & ! end of qlimit + qhcev(:) = 0.0 + chcev(:) = 0.0 + qhlcev(:) = 0.0 + chlcev(:) = 0.0 + qfcev(:) = 0.0 + do mgs = 1,ngscnt qisbv(mgs) = 0.0 qssbv(mgs) = 0.0 qidpv(mgs) = 0.0 qsdpv(mgs) = 0.0 + qhsbv(mgs) = 0.0 + qscev(mgs) = 0.0 + cscev(mgs) = 0.0 IF ( icond .eq. 1 .or. temg(mgs) .le. tfrh & - & .or. (qx(mgs,lr) .le. qxmin(lr) .and. qx(mgs,lc) .le. qxmin(lc)) ) THEN + & .or. (qx(mgs,lr) .le. qxmin(lr) .and. qx(mgs,lc) .le. qxmin(lc)) ) THEN ! last condition (qr qxmin(lh) ) THEN + IF ( temg(mgs) < tfr .or. .not. qhmlr(mgs) < 0.0 ) THEN + ! no liquid from melting, so evaporation is greater. Thus can calculate sublimation rate qhsbv(mgs) = max( min(qhdsv(mgs), 0.0), -qhmxd(mgs) ) - qhdpv(mgs) = Max(qhdsv(mgs), 0.0) + ENDIF + + IF ( .true. .and. qhmlr(mgs) < 0.0 .and. .not. mixedphase ) THEN + ! Liquid is forming, so find the evaporation that was subtracted from melting (if it is not condensing) +! qhcev(mgs) = & +! & evapfac*min( & +! & fmlt1e(mgs)*cx(mgs,lh)*hwvent(mgs)*xdia(mgs,lh,1), 0.0 ) + + qhcev(mgs) = evapfac*2.0*pi*(qx(mgs,lv)-qss0(mgs))* & + & cx(mgs,lh)*xdia(mgs,lh,1)*hwvent(mgs)/(qss0(mgs)*(fav(mgs)+fbv(mgs))) + + qhcev(mgs) = max(qhcev(mgs), -qhmxd(mgs)) + IF ( temg(mgs) > tfr ) qhcev(mgs) = Min(0.0, qhcev(mgs) ) + + ENDIF + ENDIF qhlsbv(mgs) = 0.0 qhldpv(mgs) = 0.0 IF ( lhl .gt. 1 ) THEN + IF ( qx(mgs,lhl) > qxmin(lhl) ) THEN + IF ( temg(mgs) < tfr .or. .not. qhlmlr(mgs) < 0.0 ) THEN qhlsbv(mgs) = max( min(qhldsv(mgs), 0.0), -qxmxd(mgs,lhl) ) qhldpv(mgs) = Max(qhldsv(mgs), 0.0) + ENDIF + IF ( qhlmlr(mgs) < 0.0 .and. .not. mixedphase ) THEN + ! Liquid is forming, so find the evaporation that was subtracted from melting (if it is not condensing) + qhlcev(mgs) = evapfac*2.0*pi*(qx(mgs,lv)-qss0(mgs))* & + & cx(mgs,lhl)*xdia(mgs,lhl,1)*hlvent(mgs)/(qss0(mgs)*(fav(mgs)+fbv(mgs))) + + qhlcev(mgs) = max(qhlcev(mgs), -qhlmxd(mgs)) + IF ( temg(mgs) > tfr ) qhlcev(mgs) = Min(0.0, qhlcev(mgs) ) + + ENDIF + ENDIF ENDIF temp1 = qidpv(mgs) + qsdpv(mgs) + qhdpv(mgs) + qhldpv(mgs) @@ -16068,6 +19407,10 @@ subroutine nssl_2mom_gs & end if end do + + + + ! ! ! compute dry growth rate of snow, graupel, and hail @@ -16094,7 +19437,7 @@ subroutine nssl_2mom_gs & ! do mgs = 1,ngscnt - IF ( temg(mgs) < tfr ) THEN + IF ( tfrdry < temg(mgs) .and. temg(mgs) < tfr ) THEN ! ! qswet(mgs) = ! > ( xdia(mgs,ls,1)*swvent(mgs)*cx(mgs,ls)*fwet1(mgs) @@ -16105,31 +19448,39 @@ subroutine nssl_2mom_gs & ! IF ( dnu(lh) .ne. 0. ) THEN ! qhwet(mgs) = qhdry(mgs) ! ELSE + IF ( incwet == 0 ) THEN qhwet(mgs) = & & ( xdia(mgs,lh,1)*hwvent(mgs)*cx(mgs,lh)*fwet1(mgs) & & + fwet2(mgs)*(qhaci(mgs) + qhacs(mgs)) ) qhwet(mgs) = max( 0.0, qhwet(mgs)) + ELSE + ENDIF + ! ENDIF qhlwet(mgs) = 0.0 IF ( lhl .gt. 1 ) THEN - qhlwet(mgs) = & - & ( xdia(mgs,lhl,1)*hlvent(mgs)*cx(mgs,lhl)*fwet1(mgs) & - & + fwet2(mgs)*(qhlaci(mgs) + qhlacs(mgs)) ) - qhlwet(mgs) = max( 0.0, qhlwet(mgs)) + IF ( incwet == 0 ) THEN + qhlwet(mgs) = & + & ( xdia(mgs,lhl,1)*hlvent(mgs)*cx(mgs,lhl)*fwet1(mgs) & + & + fwet2(mgs)*(qhlaci(mgs) + qhlacs(mgs)) ) + qhlwet(mgs) = max( 0.0, qhlwet(mgs)) + + ELSE + ENDIF ! incwet ENDIF ELSE qhwet(mgs) = qhdry(mgs) qhlwet(mgs) = qhldry(mgs) - ENDIF ! ! qhlwet(mgs) = qhldry(mgs) end do + ! ! shedding rate ! @@ -16189,7 +19540,7 @@ subroutine nssl_2mom_gs & qhshr(mgs) = -qhdry(mgs) qhlshr(mgs) = -qhldry(mgs) ELSE ! new and correct - + ! note that the qxacr terms should be zero here, so shedding at T > 0 is all from the droplets qsshr(mgs) = - qsacr(mgs) - qsacw(mgs) ! -qsdry(mgs) qhlshr(mgs) = - qhlacw(mgs) - qhlacr(mgs) ! -qhldry(mgs) qhshr(mgs) = - qhacw(mgs) - qhacr(mgs) ! -qhdry(mgs) @@ -16280,6 +19631,8 @@ subroutine nssl_2mom_gs & IF ( lvol(lh) .gt. 1 .and. .not. mixedphase) THEN ! rescale volumes to maximum density + IF ( iwetsoak ) THEN + rimdn(mgs,lh) = xdnmx(lh) raindn(mgs,lh) = xdnmx(lh) vhacw(mgs) = qhacw(mgs)*rho0(mgs)/rimdn(mgs,lh) @@ -16293,7 +19646,10 @@ subroutine nssl_2mom_gs & v2 = rho0(mgs)*qhwet(mgs)/xdnmx(lh) ! volume of frozen accretion vhsoak(mgs) = Min(v1,v2) + + ENDIF + ENDIF vhshdr(mgs) = Min(0.0, rho0(mgs)*qhwet(mgs)/xdnmx(lh) - vhacw(mgs) - vhacr(mgs) ) @@ -16349,6 +19705,8 @@ subroutine nssl_2mom_gs & IF ( lvol(lhl) .gt. 1 .and. .not. mixedphase ) THEN ! IF ( lvol(lhl) .gt. 1 .and. wetgrowthhl(mgs) ) THEN + IF ( iwetsoak ) THEN + rimdn(mgs,lhl) = xdnmx(lhl) raindn(mgs,lhl) = xdnmx(lhl) vhlacw(mgs) = qhlacw(mgs)*rho0(mgs)/rimdn(mgs,lhl) @@ -16372,6 +19730,8 @@ subroutine nssl_2mom_gs & ! vhlacw(mgs) = 0.0 ! vhlacr(mgs) = rho0(mgs)*qhlwet(mgs)/raindn(mgs,lhl) + ENDIF + ENDIF vhlshdr(mgs) = Min(0.0, rho0(mgs)*qhlwet(mgs)/xdnmx(lhl) - vhlacw(mgs) - vhlacr(mgs) ) @@ -16516,7 +19876,93 @@ subroutine nssl_2mom_gs & ltest = xdia(mgs,lh,1)*(4. + alpha(mgs,lh)) > Abs( hlcnhdia ) ! test on mass-weighted diameter ENDIF - dg0(mgs) = -1. + IF ( iusedw == 0 .and. ihlcnh == 1 ) THEN + dg0(mgs) = -1. + ELSE + IF (((qhacw(mgs) + qhacr(mgs))*dtp > qxmin(lh) .and. qx(mgs,lh) > hlcnhqmin .and. temg(mgs) .le. tfr-2.0 & + .and. temg(mgs) .gt. dwtempmin ) .or. ( wetgrowth(mgs) .and. qx(mgs,lh) > hlcnhqmin ) ) THEN +! dw = 0.01*( Exp( -temcg(mgs)/( 1.1e4 * rho0(mgs)*ehw(mgs)*qx(mgs,lc) - 1.3e3*rho0(mgs)*qx(mgs,li) + 1.0 ) ) - 1.0 ) +! dwr = 0.01*( Exp( -temcg(mgs)/( 1.1e4 * rho0(mgs)*(ehw(mgs)*qx(mgs,lc)+ehr(mgs)*qx(mgs,lr)) - & +! 1.3e3*rho0(mgs)*qx(mgs,li) + 1.0 ) ) - 1.0 ) + x = 1.1e4 * rho0(mgs)*(ehw(mgs)*qx(mgs,lc)+ehr(mgs)*qx(mgs,lr)) - & + 1.3e3*rho0(mgs)*qx(mgs,li) + 1.0 + IF ( x > 1.e-20 ) THEN + arg = Min(70.0, (-temcg(mgs)/x )) ! prevent overflow of the exp function in 32 bit + dwr = 0.01*(exp(arg) - 1.0) + ELSE + dwr = 1.e30 + ENDIF + d = dwr + IF ( dwr < 0.2 .and. dwr > 0.0 .and. rho0(mgs)*(qx(mgs,lc)+qx(mgs,lr)) > 1.e-4 ) THEN + sqrtrhovt = Sqrt( rhovt(mgs) ) + fventh = sqrtrhovt*(fpndl(mgs)**(1./3.)) * (fakvisc(mgs))**(-0.5) + fventm = sqrtrhovt*(fschm(mgs)**(1./3.)) * (fakvisc(mgs))**(-0.5) + ltemq = (tfr-163.15)/fqsat+1.5 + qvs0 = pqs(mgs)*tabqvs(ltemq) + denomdp = felf(mgs) + fcw(mgs)*temcg(mgs) + denominvdp = 1.d0/(felf(mgs) + fcw(mgs)*temcg(mgs)) + +! write(91,*) 'dw,dwr,temcg = ',100.*dw,100.*dwr,temcg(mgs) + h1 = ( -ftka(mgs)*temcg(mgs) - felv(mgs)*fwvdf(mgs)*rho0(mgs)*(qx(mgs,lv) - qvs0) ) + h2 = ehi(mgs)*qx(mgs,li)*rho0(mgs)*fci(mgs)*temcg(mgs) + h3 = Max(dwehwmin, ehw(mgs))*qx(mgs,lc) + h4 = ehr(mgs)* qx(mgs,lr) + ! iterate to find minimum diameter for wet growth. Start with value of dwr + DO n = 1,10 + d = Max(d, 1.e-4) + dold = d + vth = axx(mgs,lh)*d**bxx(mgs,lh) + x2 = fventh*sqrtrhovt*Sqrt(d*vth) + IF ( x2 > 1.4 ) THEN + ah = 0.78 + 0.308*x2 ! heat ventillation + ELSE + ah = 1.0 + 0.108*x2**2 ! mass ventillation (Beard and Pruppacher 1971, eq. 9) + ENDIF + + IF ( .false. ) THEN ! this option includes 'am' separate from ah, which makes only small differences. Otherwise equivalent to second option + x1 = fventm*sqrtrhovt*Sqrt(d*vth) + IF ( x1 > 1.4 ) THEN + am = 0.78 + 0.308*x1 ! mass ventillation (Beard and Pruppacher 1971, eq. 8) + ELSE + am = 1.0 + 0.108*x1**2 ! mass ventillation (Beard and Pruppacher 1971, eq. 9) + ENDIF + + d = 8.*denominvdp*( am*felv(mgs)*fwvdf(mgs)*rho0(mgs)*(qvs0 - qx(mgs,lv)) - ah*ftka(mgs)*temcg(mgs) )/ & + (dtp* ( ( Max(0.001,vth - vtxbar(mgs,lc,1))*h3 + & + Max(0.001,vth - vtxbar(mgs,lr,1))*h4) *rho0(mgs) + & + Max(0.001,vth - vtxbar(mgs,li,1))*h2*denominvdp)) + + ELSE + + ! Based on Farley and Orville (1986), eq. 5-9 but neglecting the Ci*(T0-Ts) term in (8) since we want Ts=T0 + ! Simplified mass rates as dm_w/dt = pi/4*d**2*(Vh - Vc)*rhoair*qc*ehw, etc. + d = 8.*ah*h1/ & + ( ( Max(0.001,vth - vtxbar(mgs,lc,1))*h3 + & + Max(0.001,vth - vtxbar(mgs,lr,1))*h4) *rho0(mgs)*denomdp + & + Max(0.001,vth - vtxbar(mgs,li,1))*h2) + + ENDIF + IF ( Abs(dold - d)/dold < 0.05 .or. ( n > 3 .and. d > dg0thresh ) ) EXIT + + ENDDO + ENDIF + + dg0(mgs) = Min( dwmax, Max( d, dwmin ) ) + ELSE + IF ( qx(mgs,lh) > qxmin(lh) .and. qx(mgs,lh) > hlcnhqmin .and. temg(mgs) .le. tfr-2.0 ) THEN + dg0(mgs) = dwmax + ELSE + dg0(mgs) = dg0thresh + 0.0001 + ENDIF + ENDIF + + IF ( ihlcnh == 3 .and. (qhacw(mgs) + qhacr(mgs))*dtp > qxmin(lh) .and. qx(mgs,lh) > hlcnhqmin & + .and. temg(mgs) .le. tfr-2.0 ) THEN + ! set a secondary condition on to capture large graupel that is riming but not in wet growth + dg0(mgs) = Min( dg0(mgs), dg0thresh - 0.0001 ) + ENDIF + + ENDIF wtest = (dg0(mgs) > 0.0 .and. dg0(mgs) < dg0thresh ) @@ -16551,18 +19997,6 @@ subroutine nssl_2mom_gs & tmp = qhacw(mgs) + qhacr(mgs) + qhaci(mgs) + qhacs(mgs) ! qtmp = Min( 1.0, xdia(mgs,lh,3)/(2.0*dh0) )*(tmp) qtmp = Min( 100.0, xdia(mgs,lh,3)/(2.0*dh0) )*(tmp) -! IF ( .false. .and. qx(mgs,lhl) + qtmp*dtp .lt. 0.5e-3 ) THEN -! hdia1 = Max(dh0, xdia(mgs,lh,3) ) -! qtmp = qtmp + Min(qxmxd(mgs,lh), Max( 0.0, & -! & ((pi*xdn(mgs,lh)*cx(mgs,lh)) / (6.0*rho0(mgs)*dtp)) & -! & *exp(-hdia1/xdia(mgs,lh,1)) & -! & *( (hdia1**3) + 3.0*(hdia1**2)*xdia(mgs,lh,1) & -! & + 6.0*(hdia1)*(xdia(mgs,lh,1)**2) + 6.0*(xdia(mgs,lh,1)**3) ) ) ) - -! ENDIF - -! qhlcnh(mgs) = Min( 0.5*(qx(mgs,lh))+tmp, xdia(mgs,lh,3)/(2.0*dh0)*(tmp) ) -! qhlcnh(mgs) = Min( qxmxd(mgs,lh), xdia(mgs,lh,3)/(2.0*dh0)*(tmp) ) qhlcnh(mgs) = Min( qxmxd(mgs,lh), qtmp ) IF ( ipconc .ge. 5 ) THEN !{ @@ -16572,8 +20006,6 @@ subroutine nssl_2mom_gs & chlcnhhl(mgs) = Min( cxmxd(mgs,lh), rho0(mgs)*qhlcnh(mgs)/(pi*xdn(mgs,lh)*dh0**3/6.0) ) r = rho0(mgs)*qhlcnh(mgs)/(xdn(mgs,lh)*xv(mgs,lh)) ! number of graupel particles at mean volume diameter -! chlcnh(mgs) = Min( Max( 1./8.*r , chlcnh(mgs)), r ) -! chlcnh(mgs) = Min( chlcnh(mgs), r ) chlcnh(mgs) = Max( chlcnhhl(mgs), r ) ENDIF !} @@ -16588,12 +20020,119 @@ subroutine nssl_2mom_gs & ELSEIF ( ihlcnh == 3 ) THEN !{ + IF ( wtest .and. & + ( qhacw(mgs)*dtp > qxmin(lh) .and. temg(mgs) .lt. tfr-2. .and. qx(mgs,lh) > hlcnhqmin ) ) THEN + ! convert number, mass, and reflectivity for d > dw + IF ( ipconc == 5 ) THEN + ! dg0(mgs) = Min( dg0(mgs), hldia1 ) + !dg0(mgs) = hldia1 + ENDIF + + ratio = Min( maxratiolu, dg0(mgs)/xdia(mgs,lh,1) ) + + + ! mass + tmp2 = gaminterp(ratio,alpha(mgs,lh),4,1) + IF ( ipconc == 5 ) THEN + ! tmp2 = Min( 0.25, tmp2 ) + ENDIF + qxd1 = qx(mgs,lh)*(tmp2) + qhlcnh(mgs) = dtpinv*qxd1 + flim = 1.0 + tmp3 = qxmxd(mgs,lh) + IF (qxd1 > tmp3 ) THEN +! flim = tmp3/(qxd1) +! qhlcnh(mgs) = flim*qhlcnh(mgs) + ENDIF + + + + IF ( ( qxd1 > qxmin(lhl) .and. ipconc > 5 ) .or. ( qxd1 > 10.*qxmin(lhl) .and. ipconc == 5) ) THEN + + ! number + tmp = gaminterp(ratio,alpha(mgs,lh),1,1) + IF ( ipconc == 5 ) THEN + ! tmp = Min( 0.2, tmp ) + ENDIF + cxd1 = flim*cx(mgs,lh)*( tmp) + chlcnh(mgs) = dtpinv*cxd1 + chlcnhhl(mgs) = chlcnh(mgs) + + IF ( qx(mgs,lhl) > qxmin(lhl) .and. dmhlopt > 0 ) THEN + tmp = rho0(mgs)*qhlcnh(mgs)/chlcnhhl(mgs) + IF ( tmp < xmas(mgs,lhl) ) THEN + ! dh0 = ( qxd1*dh0 + qx(mgs,lhl)*xmas(mgs,lhl))/( qxd1 + qx(mgs,lhl)) ! weighted average + dh0 = (( qxd1*tmp**(1./3.) + qx(mgs,lhl)*xmas(mgs,lhl)**(1./3.))/( qxd1 + qx(mgs,lhl)))**3 ! weighted average + chlcnhhl(mgs) = Min( chlcnhhl(mgs), rho0(mgs)*qhlcnh(mgs)/dh0 ) + ELSE +! dh0 = Max( dh0, xmas(mgs,lhl) ) ! when enough hail is established, do not dilute the size + ENDIF + ENDIF + + + ! reflectivity + IF ( ipconc >= 6 .and. lzh > 1 .and. lzhl > 1 ) THEN + tmp3 = gaminterp(ratio,alpha(mgs,lh),11,1) + zxd1 = flim*zx(mgs,lh)*(tmp3) + zhlcnh(mgs) = dtpinv*zxd1 + ELSE + zxd1 = 0 + ENDIF + + ELSE + qhlcnh(mgs) = 0.0 + ENDIF + + vhlcnh(mgs) = rho0(mgs)*qhlcnh(mgs)/xdn(mgs,lh) + vhlcnhl(mgs) = rho0(mgs)*qhlcnh(mgs)/Max(xdnmn(lhl), xdn(mgs,lh)) + + ENDIF + + ENDIF !} ENDDO ELSEIF ( ihlcnh == 2 ) THEN ! 10-ice type conversion +! +! Staka and Mansell (2005) type conversion +! +! hldia1 is set in micro_module and namelist +! IF ( .true. ) THEN + + ! convert number, mass, and reflectivity for d > hldia1, + ! regardless of wet growth status, but as long as riming > 0 + DO mgs = 1,ngscnt + IF ( qhacw(mgs)*dtp > qxmin(lh) .and. temg(mgs) .lt. tfr-2. .and. qx(mgs,lh) > qxmin(lh) ) THEN + ratio = Min( maxratiolu, hldia1/xdia(mgs,lh,1) ) + + ! number + tmp = gaminterp(ratio,alpha(mgs,lh),1,1) + cxd1 = cx(mgs,lh)*( tmp) + chlcnh(mgs) = dtpinv*cxd1 + chlcnhhl(mgs) = chlcnh(mgs) + + ! mass + tmp2 = gaminterp(ratio,alpha(mgs,lh),4,1) + qxd1 = qx(mgs,lh)*(tmp2) + qhlcnh(mgs) = dtpinv*qxd1 + + ! reflectivity + IF ( lzh > 1 .and. lzhl > 1 ) THEN + tmp3 = gaminterp(ratio,alpha(mgs,lh),11,1) + zxd1 = zx(mgs,lh)*(tmp3) + zhlcnh(mgs) = dtpinv*zxd1 + ELSE + zxd1 = 0 + ENDIF + vhlcnh(mgs) = rho0(mgs)*qhlcnh(mgs)/xdn(mgs,lh) + vhlcnhl(mgs) = rho0(mgs)*qhlcnh(mgs)/Max(xdnmn(lhl), xdn(mgs,lh)) + + ENDIF + + ENDDO +! ENDIF ELSEIF ( ihlcnh == 0 ) THEN do mgs = 1,ngscnt @@ -16829,6 +20368,10 @@ subroutine nssl_2mom_gs & ciacrf(mgs) = qrzfac(mgs)*ciacrf(mgs) ciacrs(mgs) = qrzfac(mgs)*ciacrs(mgs) +! IF ( lzh .gt. 1 ) THEN +! zrfrzf(mgs) = 3.6476*rho0(mgs)**2*(alpha(mgs,lr)+2.)/(xdn0(lr)**2*(alpha(mgs,lr)+1.)) * & +! ( 2.*tmp * qrfrzf(mgs) - tmp**2 * crfrzf(mgs) ) +! ENDIF vrfrzf(mgs) = qrzfac(mgs)*vrfrzf(mgs) viacrf(mgs) = qrzfac(mgs)*viacrf(mgs) @@ -16868,7 +20411,13 @@ subroutine nssl_2mom_gs & IF ( qrcev(mgs) .lt. 0. .and. lnr > 1 ) THEN ! qrcev(mgs) = -qrmxd(mgs) ! crcev(mgs) = (rho0(mgs)/(xmas(mgs,lr)+1.e-20))*qrcev(mgs) - crcev(mgs) = (cx(mgs,lr)/(qx(mgs,lr)))*qrcev(mgs) + IF ( icrcev == 1 ) THEN + crcev(mgs) = (cx(mgs,lr)/(qx(mgs,lr)))*qrcev(mgs) + ELSEIF ( icrcev == 2 ) THEN + crcev(mgs) = (cx(mgs,lr)/(qx(mgs,lr)))*qrcev(mgs)*vtxbar(mgs,lr,2)/vtxbar(mgs,lr,1) + ELSE + crcev(mgs) = 0.0 + ENDIF ELSE crcev(mgs) = 0.0 ENDIF @@ -16880,12 +20429,6 @@ subroutine nssl_2mom_gs & ! ! evaporation/condensation of wet graupel and snow ! - qscev(:) = 0.0 - cscev(:) = 0.0 - qhcev(:) = 0.0 - chcev(:) = 0.0 - qhlcev(:) = 0.0 - chlcev(:) = 0.0 IF ( lhwlg > 1 ) THEN qhcevlg(:) = 0.0 chcevlg(:) = 0.0 @@ -16895,6 +20438,7 @@ subroutine nssl_2mom_gs & chlcevlg(:) = 0.0 ENDIF + ! ! ! @@ -17711,9 +21255,11 @@ subroutine nssl_2mom_gs & & + chsbv(mgs) & & - il5(mgs)*chlcnh(mgs) & & - cscnh(mgs) + end do + ! ! @@ -17840,6 +21386,14 @@ subroutine nssl_2mom_gs & pqlwlghld(:) = 0.0 pqlwhli(:) = 0.0 pqlwhld(:) = 0.0 + IF ( ipconc > 5 ) THEN + pzhwi(:) = 0.0 + pzhwd(:) = 0.0 + pzrwi(:) = 0.0 + pzrwd(:) = 0.0 + pzhli(:) = 0.0 + pzhld(:) = 0.0 + ENDIF ! @@ -18078,7 +21632,8 @@ subroutine nssl_2mom_gs & qrcev(mgs) = frac*qrcev(mgs) qhlacr(mgs) = frac*qhlacr(mgs) vhlacr(mgs) = frac*vhlacr(mgs) -! qhcev(mgs) = frac*qhcev(mgs) + qhcev(mgs) = frac*qhcev(mgs) + qhlcev(mgs) = frac*qhlcev(mgs) IF ( warmonly < 0.5 ) THEN @@ -18124,6 +21679,8 @@ subroutine nssl_2mom_gs & ! STOP ENDIF + + end do IF ( warmonly < 0.5 ) THEN @@ -18152,7 +21709,7 @@ subroutine nssl_2mom_gs & & -qhcns(mgs) & & +(1-il5(mgs))*qsmlr(mgs) + qsshr(mgs) & !null at this point when wet snow included ! > +il5(mgs)*(qssbv(mgs)) & - & + (qssbv(mgs)) & + & + qssbv(mgs) & & + Min(0.0, qscev(mgs)) & & -qsmul(mgs) @@ -18267,53 +21824,634 @@ subroutine nssl_2mom_gs & & +(1-il5(mgs))*qhmlr(mgs) !null at this point when wet graupel included end do -! -! Hail -! - IF ( lhl .gt. 1 ) THEN +! +! Hail +! + IF ( lhl .gt. 1 ) THEN + + do mgs = 1,ngscnt + pqhli(mgs) = & + & +il5(mgs)*(qhldpv(mgs) ) & ! + (1.0-ifrzg)*(qiacrf(mgs)+qrfrzf(mgs) + qracif(mgs))) & + & +il5(mgs)*(1.0-ifrzg)*(qrfrzf(mgs) ) & + & +qhlacr(mgs)+qhlacw(mgs) & +! & +qhlacs(mgs)+qhlaci(mgs) & + & + qhlcnh(mgs) + pqhld(mgs) = & + & qhlshr(mgs) & + & +(1-il5(mgs))*qhlmlr(mgs) & +! > +il5(mgs)*qhlsbv(mgs) & + & + qhlsbv(mgs) & + & -qhlmul1(mgs) - qhcnhl(mgs) + + end do + + ENDIF ! lhl + + ENDIF ! warmonly + +! +! Liquid water on snow and graupel +! + + vhmlr(:) = 0.0 + vhlmlr(:) = 0.0 + vhfzh(:) = 0.0 + vhlfzhl(:) = 0.0 + + IF ( mixedphase ) THEN + ELSE ! set arrays for non-mixedphase graupel + +! vhshdr(:) = 0.0 + vhmlr(:) = qhmlr(:) ! not actually volume, but treated as q in rate equation +! vhsoak(:) = 0.0 + +! vhlshdr(:) = 0.0 + vhlmlr(:) = qhlmlr(:) ! not actually volume, but treated as q in rate equation +! vhlmlr(:) = rho0(:)*qhlmlr(:)/xdn(:,lhl) +! vhlsoak(:) = 0.0 + + ENDIF ! mixedphase + + + +! +! Graupel reflectivity +! + if (ndebug .gt. 0 .and. my_rank>=0 ) write(0,*) my_rank, 'graupel reflectivity' + + do mgs = 1,ngscnt + +! zhmlr(mgs) = 0.0 +! zhshr(mgs) = 0.0 +! zhmlrr(mgs) = 0.0 +! zhshrr(mgs) = 0.0 + zhdsv(mgs) = 0.0 +! IF ( lf < 1 ) THEN + IF ( ffrzh > 0.0 ) THEN + ziacr(mgs) = 0.0 + ziacrf(mgs) = 0.0 + ENDIF +! ENDIF + zhcns(mgs) = 0.0 + zhcni(mgs) = 0.0 + zhacs(mgs) = 0.0 + zhaci(mgs) = 0.0 + + ENDDO + + IF ( lzh .gt. 1 ) THEN ! + do mgs = 1,ngscnt + + + IF ( qx(mgs,lh) .gt. qxmin(lh) .and. cx(mgs,lh) .gt. 0.0 ) THEN + tmp = qx(mgs,lh)/cx(mgs,lh) + alp = Max( alphamin, alpha(mgs,lh) ) +! g1 = (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + g1 = g1x(mgs,lh) ! (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) +! g1r = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + + zhaci(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*( tmp ) * qhaci(mgs) ) + zhacs(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*( tmp ) * qhacs(mgs) ) + + IF ( .not. mixedphase .and. ibinhmlr < 1 ) THEN + zhmlr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*tmp * qhmlr(mgs) - tmp**2 * chmlr(mgs) ) + ENDIF + + zhshr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*tmp * qhshr(mgs) - tmp**2 * chshr(mgs) ) + +! IF ( lzr > 0 .and. qhshr(mgs) /= 0.0 .and. chshrr(mgs) /= 0.0 .and. ibinhmlr < 1 ) THEN + IF ( lzr > 0 .and. qhshr(mgs) /= 0.0 .and. chshrr(mgs) /= 0.0 ) THEN +! IF ( temg(mgs) > tfr + 2.0 ) THEN +! zhshrr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( 2.*tmp * qhshr(mgs) - tmp**2 * chshrr(mgs) ) +! IF ( zhshrr(mgs) > 0. ) THEN +! zhshrr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( 2.*tmp * qhshr(mgs) - tmp**2 * chshr(mgs) ) +! ENDIF +! z1 = g1shr*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhshr(mgs)**2/ chshrr(mgs) ) ! should this be g1shr? +! zhshrr(mgs) = Max( z1, zhshrr(mgs)) +! ELSE +! zhshrr(mgs) = g1shr*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhshr(mgs)**2/ chshrr(mgs) ) + + + IF ( temg(mgs) >= tfr ) THEN + ! zhshrr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn0(lr)))**2*( 2.*tmp * qhshr(mgs) - tmp**2 * chshrr(mgs) ) + ! IF ( zhshrr(mgs) > 0.0 ) THEN + ! zhshrr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn0(lr)))**2*( 2.*tmp * qhshr(mgs) - tmp**2 * chshr(mgs) ) + ! ENDIF + IF ( (shedalp + alpha(mgs,lh))*xdia(mgs,lh,1) < sheddiam ) THEN ! if not shedding small drops, then use alpha of hail + z1 = g1*(6.0*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhshr(mgs)**2/ chshrr(mgs) ) + ELSE + z1 = g1shr*(6.0*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhshr(mgs)**2/ chshrr(mgs) ) ! should this be g1shr? + ENDIF + zhshrr(mgs) = z1 +! z1 = g1mlr*(rho0(mgs)/(xdn(mgs,lr)))**2*( qhshr(mgs)**2/ chshrr(mgs) ) ! should this be g1shr? +! zhshrr(mgs) = Max( z1, zhshrr(mgs)) + ELSE + zhshrr(mgs) = g1shr*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhshr(mgs)**2/ chshrr(mgs) ) + ENDIF + + zhshrr(mgs) = Min( 0.0, zhshrr(mgs) ) + ENDIF + + IF ( zhshr(mgs) > 0.0 ) THEN + write(0,*) 'Problem with zhshr! zhshr,qhshr,chshr = ',zhshr(mgs),qhshr(mgs),chshr(mgs) + write(0,*) 'g1,tmp, qx,cx,zx = ',g1,tmp,qx(mgs,lh),cx(mgs,lh),zx(mgs,lh) + write(0,*) ( 2.*tmp * qhshr(mgs) - tmp**2 * chshr(mgs) ), 2.*tmp * qhshr(mgs), - tmp**2 * chshr(mgs) + write(0,*) 'temcg = ',temcg(mgs),'chshr recalc = ',(cx(mgs,lh)/(qx(mgs,lh)+1.e-20))*qhshr(mgs) + + STOP + ENDIF + + +! zhshr(mgs) = (xdn0(lr)/(xdn(mgs,lh)))**2*( zx(mgs,lh) * qhshr(mgs) ) + + qtmp = qhdpv(mgs) + qhcev(mgs) + qhsbv(mgs) + ctmp = chdpv(mgs) + chcev(mgs) + chsbv(mgs) + + zhdsv(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*( tmp ) * qtmp - tmp**2 * ctmp ) + + alp = Max( alphahacx, alpha(mgs,lh) ) +! g1 = (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + g1 = g1x(mgs,lh) ! (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + + IF ( .true. ) THEN ! { + IF ( qhacr(mgs) .gt. 0.0 ) THEN +! zhacr(mgs) = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*( qx(mgs,lh)/cx(mgs,lh)) * qhacr(mgs) ) + +! g1r = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) +! zhacr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*( qx(mgs,lh)/cx(mgs,lh)) * qhacr(mgs) ) + zhacr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*( qx(mgs,lh)/cx(mgs,lh)) * qhacr(mgs) ) +! zhacrf(mgs) = g1*zhacr + + +! z = g1*(6.*rho0(mgs)/(pi*1000.))**2*( (qx(mgs,lh)+dtp*qhacr(mgs))**2)/(cx(mgs,lh)) + + IF ( z > zx(mgs,lh) ) THEN +! zhacr(mgs) = (z - zx(mgs,lh))*dtpinv + ELSE +! zhacr(mgs) = 0.0 + ENDIF + ENDIF + +! zhacr(mgs) = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*( tmp ) * qhacr(mgs) ) +! zhacr(mgs) = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*( tmp ) * qhacr(mgs) - tmp**2 * chacr(mgs) ) + +! alp = Max( 1.0, alpha(mgs,lh)+1. ) +! g1 = (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/ +! : ((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + IF ( qhacw(mgs) .gt. 0.0 ) THEN +! zhacw(mgs) = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*( qx(mgs,lh)/cx(mgs,lh)) * qhacw(mgs) ) + zhacw(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*( qx(mgs,lh)/cx(mgs,lh)) * qhacw(mgs) ) + +! z = g1*(6.*rho0(mgs)/(pi*1000.))**2*( (qx(mgs,lh)+dtp*(qhacw(mgs)-qhmul1(mgs)))**2)/(cx(mgs,lh)) + IF ( z > zx(mgs,lh) ) THEN +! zhacw(mgs) = (z - zx(mgs,lh))*dtpinv + ENDIF + ENDIF + + ELSE ! } { ! this is not used because of the 'true' above + + IF ( qhacw(mgs) .gt. 0.0 .or. qhacr(mgs) .gt. 0.0 ) THEN + z = g1*(6.*rho0(mgs)/(pi*1000.))**2*( (qx(mgs,lh)+dtp*(qhacr(mgs) + qhacw(mgs)-qhmul1(mgs)))**2)/(cx(mgs,lh)) +! zhacw(mgs) = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*( qx(mgs,lh)/cx(mgs,lh)) * qhacw(mgs) ) + IF ( z > zx(mgs,lh) ) THEN + zhacw(mgs) = (z - zx(mgs,lh))*dtpinv + ENDIF + ENDIF + + ENDIF ! } + + IF ( qhlcnh(mgs) .gt. 0.0 .and. ihlcnh < 2 ) THEN + zhlcnh(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*( tmp ) * qhlcnh(mgs) - tmp**2 * chlcnh(mgs) ) + ENDIF + ENDIF +! qsplinter(mgs) + IF ( ffrzh*qiacrf(mgs) .gt. 0.0 .and. cx(mgs,lr) .gt. 0.0 .and. qx(mgs,lr) .gt. qxmin(lr) ) THEN + tmp = qx(mgs,lr)/cx(mgs,lr) +! alp = 3.0 +! g1 = (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + IF ( imurain == 3 ) THEN + ! note that 3.6476 = (6/pi)**2 + ziacr(mgs) = 3.6476*rho0(mgs)**2*(alpha(mgs,lr)+2.)/(xdn0(lr)**2*(alpha(mgs,lr)+1.))* & + & ( 2.*tmp * qiacrf(mgs) - tmp**2 * ciacrf(mgs) ) + ELSE ! imurain == 1 + ziacr(mgs) = 3.6476*rho0(mgs)**2*g1x(mgs,lr)/(xdn0(lr)**2)* & + & ( 2.*tmp * qiacrf(mgs) - tmp**2 * ciacrf(mgs) ) + ENDIF + ziacr(mgs) = Min( ziacr(mgs), zxmxd(mgs,lr) ) +! ziacrf(mgs) = (xdn(mgs,lr)/xdn(mgs,lh))**2 * ziacr(mgs) + ziacrf(mgs) = (xdn(mgs,lr)/xdnmx(lh))**2 * ziacr(mgs) +! z = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*tmp * (qiacrf(mgs) - qsplinter(mgs)) - tmp**2 * ciacrf(mgs) ) +! ziacrf(mgs) = Min( ziacrf(mgs), z ) + ENDIF + + + + IF ( ffrzh*qrfrzf(mgs) .gt. 0.0 .and. cx(mgs,lr) .gt. 0.0 ) THEN + tmp = qx(mgs,lr)/cx(mgs,lr) +! alp = 3.0 +! g1 = (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + IF ( imurain == 3 ) THEN + zrfrz(mgs) = 3.6476*rho0(mgs)**2*(alpha(mgs,lr)+2.)/(xdn0(lr)**2*(alpha(mgs,lr)+1.)) * & + & ( 2.*tmp * qrfrzf(mgs) - tmp**2 * crfrzf(mgs) ) + zrfrzf(mgs) = (xdn(mgs,lr)/xdn(mgs,lh))**2 * zrfrz(mgs) + ELSEIF ( imurain == 1 .and. ibiggopt /= 2 ) THEN +! zrfrz(mgs) = 3.6476*rho0(mgs)**2*g1x(mgs,lr)/(xdn0(lr)**2) * & +! & ( 2.*tmp * qrfrzf(mgs) - tmp**2 * crfrz(mgs) ) + zrfrz(mgs) = 3.6476*rho0(mgs)**2*g1x(mgs,lr)/(xdn0(lr)**2) * & + & ( 2.*tmp * qrfrz(mgs) - tmp**2 * crfrz(mgs) ) + zrfrzf(mgs) = 3.6476*rho0(mgs)**2*g1x(mgs,lr)/(rhofrz**2) * & + & ( 2.*tmp * qrfrzf(mgs) - tmp**2 * crfrzf(mgs) ) + ENDIF + zrfrz(mgs) = Min( zrfrz(mgs), Max(0.4,qrfrz(mgs)/qx(mgs,lr))*zx(mgs,lr)*dtpinv ) +! zrfrzf(mgs) = (xdn(mgs,lr)/xdn(mgs,lh))**2 * zrfrz(mgs) +! zrfrzf(mgs) = (xdn(mgs,lr)/xdnmx(lh))**2 * zrfrz(mgs) +! z = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*tmp * (qrfrzf(mgs)-qsplinter2(mgs)) - tmp**2 * crfrzf(mgs) ) +! zrfrzf(mgs) = Min( zrfrzf(mgs), z ) + ! change this to be alpha=0? + ENDIF + + IF ( lhl > 1 .and. qhcnhl(mgs) .gt. 0.0 ) THEN + tmp = qx(mgs,lhl)/cx(mgs,lhl) + zhcnhl(mgs) = g1x(mgs,lhl)*(6.*rho0(mgs)/(pi*xdn(mgs,lhl)))**2*( 2.*( tmp ) * qhcnhl(mgs) - tmp**2 * chcnhl(mgs) ) + + ENDIF + + IF ( qhcns(mgs) > 0.0 .and. chcns(mgs) > 0.0 .and. cx(mgs,ls) > cxmin .and. vhcns(mgs) > 0 ) THEN + tmp = qx(mgs,ls)/cx(mgs,ls) + r = rho0(mgs)*qhcns(mgs)/vhcns(mgs) ! density of new graupel particles + IF ( imusnow == 3 ) THEN + zhcns(mgs) = 3.6476*rho0(mgs)**2*(alpha(mgs,ls)+2.)/(r**2*(alpha(mgs,ls)+1.)) * & + & ( 2.*tmp * qhcns(mgs) - tmp**2 * chcns(mgs) ) + ELSE + write(0,*) 'Value of imusnow not valid. Must be 3 (fix me for =1). imusnow = ',imusnow + STOP + ENDIF + ENDIF + + IF ( qhcni(mgs) > 0.0 .and. chcni(mgs) > 0.0 .and. cx(mgs,li) > cxmin .and. vhcni(mgs) > 0 ) THEN + tmp = qx(mgs,li)/cx(mgs,li) + r = rho0(mgs)*qhcni(mgs)/vhcni(mgs) ! density of new graupel particles + zhcni(mgs) = 3.6476*rho0(mgs)**2*(alpha(mgs,li)+2.)/(r**2*(alpha(mgs,li)+1.)) * & + & ( 2.*tmp * qhcni(mgs) - tmp**2 * chcni(mgs) ) + ENDIF + + + pzhwi(mgs) = & + & +ifrzg*ffrzh*(zrfrzf(mgs) & + & +il5(mgs)*ifiacrg*(ziacrf(mgs) ) ) & +! : + zhcnsh(mgs) + zhcnih(mgs) & + & + zhacw(mgs) & + & + zhacr(mgs) & + & + zhcnhl(mgs) & + & + zhacs(mgs) & + & + zhaci(mgs) & + & + f2h*zhcni(mgs) + f2h*zhcns(mgs) & + & + Max( 0.0, zhdsv(mgs) ) + + pzhwd(mgs) = 0.0 & + & + (1-il5(mgs))*zhmlr(mgs) & + & + zhshr(mgs) & + & + Min( 0.0, zhdsv(mgs) ) & + & - il5(mgs)*zhlcnh(mgs) + + + IF ( igs(mgs) == 44 .and. kgs(mgs) == 23 .or. dtp*( pqhwi(mgs) + pqhwd(mgs) ) > qxmin(lh) ) THEN +! write(0,*) 'i,k,time = ',igs(mgs),kgs(mgs),time_real +! write(0,*) 'pzhwi,d = ',pzhwi(mgs),pzhwd(mgs),dtp*( pzhwi(mgs) + pzhwd(mgs) ),zx(mgs,lh) +! write(0,*) 'pqhwi,d = ',pqhwi(mgs),pqhwd(mgs),dtp*( pqhwi(mgs) + pqhwd(mgs) ),qx(mgs,lh) +! write(0,*) 'pchwi,d = ',pchwi(mgs),pchwd(mgs),dtp*( pchwi(mgs) + pchwd(mgs) ),cx(mgs,lh) + ENDIF + + +! IF ( zhcnhl(mgs) < 0.0 ) THEN +! write(0,*) 'Problem with zhcnhl! zhcnhl,qhcnhl,chcnhl = ',zhcnhl(mgs),qhcnhl(mgs),chcnhl(mgs) +! write(0,*) 'g1,tmp = ',g1x(mgs,lhl),tmp +! write(0,*) ( 2.*( tmp ) * qhcnhl(mgs) - tmp**2 * chcnhl(mgs) ) +! +!! STOP +! ENDIF + end do + + if (ndebug .gt. 0 .and. my_rank>=0 ) write(0,*) my_rank, 'end graupel reflectivity' + + ENDIF + +! +! Hail reflectivity +! + + do mgs = 1,ngscnt + + zhldsv(mgs) = 0.0 + zhlacr(mgs) = 0.0 + zhlacw(mgs) = 0.0 + + ENDDO + + IF ( lzhl .gt. 1 .or. ( lzr > 1 .and. lnhl > 1 ) ) THEN ! also run for 2-moment hail for 3-moment rain sources + + if (ndebug .gt. 0 .and. my_rank>=0 ) write(0,*) my_rank, 'hail reflectivity' + + do mgs = 1,ngscnt + + IF ( qx(mgs,lhl) .gt. qxmin(lhl) .and. cx(mgs,lhl) .gt. 0.0 ) THEN + tmp = qx(mgs,lhl)/cx(mgs,lhl) + alp = Max( alphamin, alpha(mgs,lhl) ) +! g1 = (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + g1 = g1x(mgs,lhl) ! (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + + IF ( .not. mixedphase .and. qhlmlr(mgs) /= 0.0 .and. chlmlr(mgs) /= 0.0 .and. ibinhlmlr < 1 ) THEN + zhlmlr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lhl)))**2*( 2.*tmp * qhlmlr(mgs) - tmp**2 * chlmlr(mgs) ) + ENDIF + + zhlshr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lhl)))**2*( 2.*tmp * qhlshr(mgs) - tmp**2 * chlshr(mgs) ) + IF ( lzr > 1 .and. qhlshr(mgs) /= 0.0 .and. chlshrr(mgs) /= 0.0 ) THEN + IF ( temg(mgs) >= tfr ) THEN + ! zhlshrr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn0(lr)))**2*( 2.*tmp * qhlshr(mgs) - tmp**2 * chlshrr(mgs) ) + ! IF ( zhlshrr(mgs) > 0.0 ) THEN + ! zhlshrr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn0(lr)))**2*( 2.*tmp * qhlshr(mgs) - tmp**2 * chlshr(mgs) ) + ! ENDIF + IF ( (shedalp + alpha(mgs,lhl))*xdia(mgs,lhl,1) < sheddiam ) THEN ! if not shedding small drops, then use alpha of hail + z1 = g1*(6.0*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhlshr(mgs)**2/ chlshrr(mgs) ) + ELSE + z1 = g1shr*(6.0*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhlshr(mgs)**2/ chlshrr(mgs) ) ! should this be g1shr? + ENDIF + zhlshrr(mgs) = z1 +! z1 = g1mlr*(rho0(mgs)/(xdn(mgs,lr)))**2*( qhlshr(mgs)**2/ chlshrr(mgs) ) ! should this be g1shr? +! zhlshrr(mgs) = Max( z1, zhlshrr(mgs)) + ELSE + zhlshrr(mgs) = g1shr*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhlshr(mgs)**2/ chlshrr(mgs) ) + ENDIF + + zhlshrr(mgs) = Min( 0.0, zhlshrr(mgs) ) + ENDIF + + IF ( zhlshr(mgs) > 0.0 ) THEN + write(0,*) 'Problem with zhlshr! zhlshr,qhlshr,chlshr = ',zhlshr(mgs),qhlshr(mgs),chlshr(mgs) + write(0,*) 'g1,tmp, qx,cx,zx = ',g1,tmp,qx(mgs,lhl),cx(mgs,lhl),zx(mgs,lhl) + write(0,*) ( 2.*tmp * qhlshr(mgs) - tmp**2 * chlshr(mgs) ), 2.*tmp * qhlshr(mgs), - tmp**2 * chlshr(mgs) + write(0,*) 'temcg = ',temcg(mgs),'chlshr recalc = ',(cx(mgs,lhl)/(qx(mgs,lhl)+1.e-20))*qhlshr(mgs) + + STOP + ENDIF +! zhlshr(mgs) = Min( 0.0, zhlshr(mgs) ) + +! zhlshr(mgs) = (xdn0(lr)/(xdn(mgs,lhl)))**2*( zx(mgs,lhl) * qhlshr(mgs) ) + + qtmp = qhldpv(mgs) + qhlcev(mgs) + ctmp = chldpv(mgs) + chlcev(mgs) + + zhldsv(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lhl)))**2*( 2.*( tmp ) * qtmp - tmp**2 * ctmp ) + + alp = Max( alphahacx, alpha(mgs,lhl) ) +! g1 = (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + g1 = g1x(mgs,lhl) ! (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + + IF ( .true. ) THEN ! { + IF ( qhlacr(mgs) .gt. 0.0 ) THEN +! z = g1*(6.*rho0(mgs)/(pi*1000.))**2*( (qx(mgs,lhl)+dtp*qhlacr(mgs))**2)/(cx(mgs,lhl)) + zhlacr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lhl)))**2*( 2.*( tmp ) * qhlacr(mgs) ) +! zhlacr(mgs) = Min( zxmxd(mgs,lr), zhlacr(mgs) ) + +! IF ( z > zx(mgs,lhl) ) THEN +! zhlacr(mgs) = (z - zx(mgs,lhl))*dtpinv +! ELSE +! zhlacr(mgs) = 0.0 +! ENDIF + ENDIF + +! zhacr(mgs) = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*( tmp ) * qhacr(mgs) ) +! zhacr(mgs) = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*( tmp ) * qhacr(mgs) - tmp**2 * chacr(mgs) ) + + IF ( qhlacw(mgs) .gt. 0.0 ) THEN + alp = Max( 3.0, alpha(mgs,lhl)+1. ) + g1 = (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + +! z = g1*(6.*rho0(mgs)/(pi*1000.))**2*( (qx(mgs,lhl)+dtp*(qhlacw(mgs)-qhlmul1(mgs)))**2)/(cx(mgs,lhl)) +! zhlacw(mgs) = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*( qx(mgs,lhl)/cx(mgs,lhl)) * qhlacw(mgs) ) + zhlacw(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lhl)))**2*( 2.*tmp * qhlacw(mgs) ) + +! IF ( z > zx(mgs,lhl) ) THEN +! zhlacw(mgs) = (z - zx(mgs,lhl))*dtpinv +! ENDIF + g1 = g1x(mgs,lhl) ! (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + ENDIF + + ELSE ! } .false. { + + IF ( qhlacw(mgs) .gt. 0.0 .or. qhlacr(mgs) .gt. 0.0 ) THEN + z = g1*(6.*rho0(mgs)/(pi*1000.))**2*( (qx(mgs,lhl)+dtp*(qhlacr(mgs) + qhlacw(mgs)-qhlmul1(mgs)))**2)/(cx(mgs,lhl)) +! zhlacw(mgs) = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*( qx(mgs,lhl)/cx(mgs,lhl)) * qhlacw(mgs) ) + IF ( z > zx(mgs,lhl) ) THEN + zhlacw(mgs) = (z - zx(mgs,lhl))*dtpinv + ENDIF + ENDIF + + ENDIF ! } + + ENDIF +! qsplinter(mgs) + + IF ( lzhl > 1 ) THEN + pzhli(mgs) = ffrzh*(((1.0-ifrzg)*zrfrzf(mgs) & + & +il5(mgs)*(1.0-ifiacrg)*ziacrf(mgs) )) & + & + il5(mgs)*zhlcnh(mgs) & + & + zhlacw(mgs) & + & + zhlacr(mgs) & +! : + zhlacs(mgs) & + & + Max( 0.0, zhldsv(mgs) ) + + pzhld(mgs) = 0.0 & + & + (1-il5(mgs))*zhlmlr(mgs) & + & + zhlshr(mgs) & + & - zhcnhl(mgs) & + & + Min( 0.0, zhldsv(mgs) ) + + + IF ( .not. ( -1.0 < pzhli(mgs) .and. pzhli(mgs) < 1.e20 ) ) THEN + write(iunit,*) 'Problem with pzhli!' + write(iunit,*) 'zhlcnh,zhlacw,zhlacr,zhldsv = ',zhlcnh(mgs),zhlacw(mgs),zhlacr(mgs),zhldsv(mgs) + ENDIF + + IF ( .not. ( -1.0e20 < pzhld(mgs) .and. pzhld(mgs) < 1. ) ) THEN + write(iunit,*) 'Problem with pzhld!' + write(iunit,*) 'zhlmlr,zhlshr,zhldsv = ',zhlmlr(mgs),zhlshr(mgs),zhldsv(mgs) + ENDIF + + ENDIF ! lzhl > 1 + + end do + + ENDIF + +! +! rain reflectivity +! + if (ndebug .gt. 0 ) write(0,*) 'WARMZIEG: dbg = 11' + + IF ( lzr .gt. 1 ) THEN ! + + DO mgs = 1,ngscnt + + zracw(mgs) = 0.0 + zracr(mgs) = 0.0 + zrcev(mgs) = 0.0 + zrach(mgs) = 0.0 + zrachl(mgs) = 0.0 + zsshr(mgs) = 0.0 + zsshrr(mgs) = 0.0 +! zsmlr(mgs) = 0.0 + zsmlrr(mgs) = 0.0 + + IF ( qx(mgs,ls) .gt. qxmin(ls) .and. ( csmlr(mgs) /= 0.0 .or. csshr(mgs) /= 0.0 .or. & + csmlrr(mgs) /= 0.0 .or. csshrr(mgs) /= 0.0) ) THEN !{ + tmp = qx(mgs,ls)/cx(mgs,ls) + g1 = 36.*(xnu(ls)+2.0)/((xnu(ls)+1.0)*pi**2) + IF ( .not. mixedphase ) THEN +! zsmlr(mgs) = (xdn(mgs,ls)/xdn(mgs,lr))**2*g1*(rho0(mgs)/(xdn(mgs,ls)))**2* & +! & ( 2.*tmp * qsmlr(mgs) - tmp**2 * csmlr(mgs) ) + + IF ( csmlrr(mgs) /= 0.0 ) THEN + z1 = g1smlr*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qsmlr(mgs)**2/ csmlrr(mgs) ) + zsmlrr(mgs) = z1 + ENDIF + ENDIF + +! zsshr(mgs) = (xdn(mgs,ls)/xdn(mgs,lr))**2*g1*(rho0(mgs)/(xdn(mgs,ls)))**2* & +! & ( 2.*tmp * qsshr(mgs) - tmp**2 * csshr(mgs) ) + + IF ( csshrr(mgs) /= 0.0 ) THEN + z1 = g1smlr*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qsshr(mgs)**2/ csshrr(mgs) ) + zsshrr(mgs) = z1 + ENDIF + + ENDIF !} + + IF ( .not. mixedphase ) THEN !{ + IF ( zhmlr(mgs) < 0.0 .and. chmlrr(mgs) /= 0.0 .and. ibinhmlr == 0 ) THEN !{ + tmp = qx(mgs,lh)/cx(mgs,lh) +! zhmlrr(mgs) = Min(0.0, (xdn(mgs,lh)/xdn(mgs,lr))**2 * & +! & g1x(mgs,lh)*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*tmp * qhmlr(mgs) - tmp**2 * chmlrr(mgs) ) ) + +! IF ( zhmlrr(mgs) >= 0. ) THEN +! zhmlrr(mgs) = (xdn(mgs,lh)/xdn(mgs,lr))**2 * zhmlr(mgs) +! ENDIF + IF ( (shedalp + alpha(mgs,lh))*xdia(mgs,lh,1) < sheddiam ) THEN ! if not shedding small drops, then use alpha of graupel + z1 = g1x(mgs,lh)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhmlr(mgs)**2/ chmlrr(mgs) ) + ELSE ! assume drops are shed off, so use either alpha for shedding or graupel alpha, whichever gives the lower g-factor (i.e., larger alpha) + z1 = Min(g1x(mgs,lh),g1shr)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhmlr(mgs)**2/ chmlrr(mgs) ) + ENDIF + zhmlrr(mgs) = z1 +! z1 = g1mlr*(rho0(mgs)/(xdn(mgs,lr)))**2*( qhmlr(mgs)**2/ chmlrr(mgs) ) +! zhmlrr(mgs) = Max( z1, zhmlrr(mgs)) + ENDIF !} + + +! zhshrr(mgs) = (xdn(mgs,lh)/xdn(mgs,lr))**2 * zhshr(mgs) + + IF ( lhl > 1 .and. qhlmlr(mgs) /= 0 .and. ibinhlmlr == 0) THEN + tmp = qx(mgs,lhl)/cx(mgs,lhl) +! zhlmlrr(mgs) = Min(0.0, (xdn(mgs,lhl)/xdn(mgs,lr))**2 * & +! & g1x(mgs,lhl)*(6.*rho0(mgs)/(pi*xdn(mgs,lhl)))**2*( 2.*tmp * qhlmlr(mgs) - tmp**2 * chlmlrr(mgs) ) ) + +! IF ( zhlmlrr(mgs) >= 0. ) THEN ! should be negative, if not, then use alternate calculation +! zhlmlrr(mgs) = (xdn(mgs,lhl)/xdn(mgs,lr))**2 * zhlmlr(mgs) +! ENDIF + + IF ( (shedalp + alpha(mgs,lhl))*xdia(mgs,lhl,1) < sheddiam ) THEN ! if not shedding small drops, then use alpha of hail + z1 = g1x(mgs,lhl)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhlmlr(mgs)**2/ chlmlrr(mgs) ) + ELSE ! assume drops are shed off, so use either alpha for shedding or graupel alpha, whichever gives the lower g-factor (i.e., larger alpha) + z1 = Min(g1x(mgs,lhl),g1shr)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhlmlr(mgs)**2/ chlmlrr(mgs) ) +! z1 = g1shr*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhlmlr(mgs)**2/ chlmlrr(mgs) ) + ENDIF + zhlmlrr(mgs) = z1 + +! z1 = g1mlr*(rho0(mgs)/(xdn(mgs,lr)))**2*( qhlmlr(mgs)**2/ chlmlrr(mgs) ) +! zhlmlrr(mgs) = Max( z1, zhlmlrr(mgs)) +! zhlmlr(mgs) = +! zhlshrr(mgs) = (xdn(mgs,lhl)/xdn(mgs,lr))**2 * zhlshr(mgs) + ENDIF + + ENDIF ! } + + IF ( qx(mgs,lr) .gt. qxmin(lr) .and. cx(mgs,lr) .gt. 0.0 ) THEN + + tmp = qx(mgs,lr)/cx(mgs,lr) + g1 = g1x(mgs,lr) ! 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + + + IF ( qracw(mgs) > 0.0 .and. cx(mgs,lr) > 0.0 ) THEN + zracw(mgs) = g1x(mgs,lr)*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*tmp * qracw(mgs) ) + ENDIF + + IF ( cracr(mgs) > 0.0 .and. cx(mgs,lr) > 0.0 ) THEN + zracr(mgs) = g1x(mgs,lr)*(6.*rho0(mgs)/(pi*1000.))**2*( tmp**2 * cracr(mgs) ) + ENDIF + + qtmp = qrcev(mgs) + ctmp = crcev(mgs) + +! IF ( .false. .or. iferwisventr == 2 ) THEN +! zrcev(mgs) = Min(0.0, (12./(pii*xdn(mgs,lr)))*xdia(mgs,lr,1)**3*fvce(mgs)*rwcap(mgs)*rwventz(mgs) ) +! ELSE + zrcev(mgs) = g1x(mgs,lr)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( 2.*( tmp ) * qtmp - tmp**2 * ctmp ) + + + IF ( iferwisventr == 2 ) THEN + vent1 = Min(0.0, (12./(pii*xdn(mgs,lr)))*xdia(mgs,lr,1)**3*fvce(mgs)*rwcap(mgs)*rwventz(mgs)) + zrcev(mgs) = Max( zrcev(mgs), vent1 ) + ENDIF +! IF ( ny == 2 .and. igs(mgs) == 20 ) THEN +! write(0,*) 'k,zrcevold,new,maxdep : ',kgs(mgs),zrcev(mgs),vent1,-zxmxd(mgs,lr),alpha(mgs,lr),cx(mgs,lr) +! ENDIF + + +! ENDIF + zrcev(mgs) = Max( zrcev(mgs), -zxmxd(mgs,lr) ) + + IF ( qhacr(mgs) > 0.0 ) THEN + zrach(mgs) = g1x(mgs,lr)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2* & + & ( 2.*( qx(mgs,lr)/cx(mgs,lr)) * qhacr(mgs) - tmp**2 * chacr(mgs) ) + zrach(mgs) = Min( zrach(mgs), zxmxd(mgs,lr) ) + + ENDIF + + IF ( lhl > 1 .and. qhlacr(mgs) > 0.0 ) THEN + zrachl(mgs) = g1x(mgs,lr)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2* & + & ( 2.*( qx(mgs,lr)/cx(mgs,lr)) * qhlacr(mgs) - tmp**2 * chlacr(mgs) ) + zrachl(mgs) = Min( zrachl(mgs), zxmxd(mgs,lr) ) + ENDIF - do mgs = 1,ngscnt - pqhli(mgs) = & - & +il5(mgs)*(qhldpv(mgs) ) & ! + (1.0-ifrzg)*(qiacrf(mgs)+qrfrzf(mgs) + qracif(mgs))) & - & +il5(mgs)*(1.0-ifrzg)*(qrfrzf(mgs) ) & - & +qhlacr(mgs)+qhlacw(mgs) & -! & +qhlacs(mgs)+qhlaci(mgs) & - & + qhlcnh(mgs) - pqhld(mgs) = & - & qhlshr(mgs) & - & +(1-il5(mgs))*qhlmlr(mgs) & -! > +il5(mgs)*qhlsbv(mgs) & - & + qhlsbv(mgs) & - & -qhlmul1(mgs) - qhcnhl(mgs) - end do + + ENDIF - ENDIF ! lhl + pzrwi(mgs) = zrcnw(mgs) + zracw(mgs) + zracr(mgs) & + & + Max( 0.,zrcev(mgs) ) & + & - (1-il5(mgs))*zsmlrr(mgs) & + & - zsshrr(mgs) & + & - (1-il5(mgs))*zhmlrr(mgs) & + & - zhshrr(mgs) & + & - (1-il5(mgs))*zhlmlrr(mgs) & + & - zhlshrr(mgs) - ENDIF ! warmonly -! -! Liquid water on snow and graupel -! + pzrwd(mgs) = 0.0 & + & + Min(0.,zrcev(mgs) ) & + & - zrach(mgs) & + & - zrachl(mgs) & + & - zrfrz(mgs) & + & - il5(mgs)*(ziacr(mgs) ) - vhmlr(:) = 0.0 - vhlmlr(:) = 0.0 - vhfzh(:) = 0.0 - vhlfzhl(:) = 0.0 - IF ( mixedphase ) THEN - ELSE ! set arrays for non-mixedphase graupel - -! vhshdr(:) = 0.0 - vhmlr(:) = qhmlr(:) ! not actually volume, but treated as q in rate equation -! vhsoak(:) = 0.0 + IF ( zx(mgs,lr) + dtp*(pzrwi(mgs)+pzrwd(mgs)) <= 0.0 & + .and. qx(mgs,lr) > qxmin(lr) ) THEN + pzrwd(mgs) = -zx(mgs,lr)*dtpinv - pzrwi(mgs) + ENDIF -! vhlshdr(:) = 0.0 - vhlmlr(:) = qhlmlr(:) ! not actually volume, but treated as q in rate equation -! vhlmlr(:) = rho0(:)*qhlmlr(:)/xdn(:,lhl) -! vhlsoak(:) = 0.0 + ENDDO - ENDIF ! mixedphase + ENDIF @@ -18390,6 +22528,33 @@ subroutine nssl_2mom_gs & ! > + rho0(mgs)*qhshr(mgs)/xdn(mgs,lh) !xdn(mgs,lr) ! ENDIF + IF ( lzh > 1 .and. qx(mgs,lh) > qxmin(lh) ) THEN +! Calculate change in reflectivity due to density changes + + xdn_new = rho0(mgs)*(qx(mgs,lh) + dtp*(pqhwi(mgs) + pqhwd(mgs) ))/ & + & (vx(mgs,lh) + dtp*(pvhwi(mgs) + pvhwd(mgs)) ) + + IF ( mixedphase ) THEN + IF ( qxw(mgs,lh) .gt. 0.0 ) THEN + dnmx = xdnmx(lr) + ELSE + dnmx = xdnmx(lh) + ENDIF + ELSE + dnmx = xdnmx(lh) + ENDIF + + xdn_new = Max( Min( xdn_new, dnmx ), xdnmn(lh) ) + + drhodt = (xdn_new - xdn(mgs,lh))*dtpinv + + zhwdn(mgs) = -2.*g1x(mgs,lh)*(rho0(mgs)*qx(mgs,lh)*6.*pii )**2/(cx(mgs,lh)*xdn(mgs,lh)**3)*drhodt + + pzhwi(mgs) = pzhwi(mgs) + Max(0.0, zhwdn(mgs)) + pzhwd(mgs) = pzhwd(mgs) + Min(0.0, zhwdn(mgs)) + + + ENDIF IF ( .false. .and. ny .eq. 2 .and. kgs(mgs) .eq. 9 .and. igs(mgs) .eq. 19 ) THEN write(iunit,*) @@ -18472,6 +22637,32 @@ subroutine nssl_2mom_gs & & + rho0(mgs)*(1-il5(mgs))*vhlmlr(mgs)/xdn(mgs,lhl) & & + vhlshdr(mgs) - vhlsoak(mgs) + IF ( lzhl > 1 .and. qx(mgs,lhl) > qxmin(lhl) ) THEN +! Calculate change in reflectivity due to density changes + + xdn_new = rho0(mgs)*(qx(mgs,lhl) + dtp*(pqhli(mgs) + pqhld(mgs) ))/ & + & (vx(mgs,lhl) + dtp*(pvhli(mgs) + pvhld(mgs)) ) + + IF ( mixedphase ) THEN + IF ( qxw(mgs,lhl) .gt. 0.0 ) THEN + dnmx = xdnmx(lr) + ELSE + dnmx = xdnmx(lhl) + ENDIF + ELSE + dnmx = xdnmx(lhl) + ENDIF + xdn_new = Max( Min( xdn_new, dnmx ), xdnmn(lhl) ) + + drhodt = (xdn_new - xdn(mgs,lhl))*dtpinv + + zhldn(mgs) = -2.*g1x(mgs,lhl)*(rho0(mgs)*qx(mgs,lhl)*6.*pii )**2/(cx(mgs,lhl)*xdn(mgs,lhl)**3)*drhodt + + pzhli(mgs) = pzhli(mgs) + Max(0.0, zhldn(mgs)) + pzhld(mgs) = pzhld(mgs) + Min(0.0, zhldn(mgs)) + + + ENDIF ENDDO @@ -18701,7 +22892,7 @@ subroutine nssl_2mom_gs & write(iunit,*) -qracs(mgs)*(1-il2(mgs)) , qhacs(mgs) , qhlacs(mgs) write(iunit,*) -qhcns(mgs) write(iunit,*) +(1-il5(mgs))*qsmlr(mgs) , qsshr(mgs) - write(iunit,*) (qssbv(mgs)) + write(iunit,*) qssbv(mgs) write(iunit,*) Min(0.0, qscev(mgs)) write(iunit,*) -qsmul(mgs) ! @@ -18773,33 +22964,37 @@ subroutine nssl_2mom_gs & IF ( warmonly < 0.5 ) THEN pfrz(mgs) = & & (1-il5(mgs))* & - & (qhmlr(mgs)+qsmlr(mgs)+qhlmlr(mgs)) & !+qhmlh(mgs)) & - & +il5(mgs)*(qhfzh(mgs)+qsfzs(mgs)+qhlfzhl(mgs)) & + & (qhmlr(mgs)+ & + & qsmlr(mgs)+qhlmlr(mgs)) & !+qhmlh(mgs)) & & +il5(mgs)*(1-imixedphase)*( & & qsacw(mgs)+qhacw(mgs) + qhlacw(mgs) & & +qsacr(mgs)+qhacr(mgs) + qhlacr(mgs) & & +qsshr(mgs) & & +qhshr(mgs) & - & +qhlshr(mgs) +qrfrz(mgs)+qiacr(mgs) & + & +qhlshr(mgs) & + & +qrfrz(mgs)+qiacr(mgs) & & ) & & +il5(mgs)*(qwfrz(mgs) & & +qwctfz(mgs)+qiihr(mgs) & & +qiacw(mgs)) pmlt(mgs) = & & (1-il5(mgs))* & - & (qhmlr(mgs)+qsmlr(mgs)+qhlmlr(mgs)) !+qhmlh(mgs)) + & (qhmlr(mgs)+qsmlr(mgs)+ & + & qhlmlr(mgs)) !+qhmlh(mgs)) ! NOTE: psub is sum of sublimation and deposition psub(mgs) = & & il5(mgs)*( & & + qsdpv(mgs) + qhdpv(mgs) & & + qhldpv(mgs) & & + qidpv(mgs) + qisbv(mgs) ) & - & + qssbv(mgs) + qhsbv(mgs) + qhlsbv(mgs) & + & + qssbv(mgs) + qhsbv(mgs) & + & + qhlsbv(mgs) & & +il5(mgs)*(qiint(mgs)) pvap(mgs) = & - & qrcev(mgs) + qhcev(mgs) + qscev(mgs) + qhlcev(mgs) + & qrcev(mgs) + qhcev(mgs) + qscev(mgs) + qhlcev(mgs) + qfcev(mgs) pevap(mgs) = & - & Min(0.0,qrcev(mgs)) + Min(0.0,qhcev(mgs)) + Min(0.0,qscev(mgs)) + Min(0.0,qhlcev(mgs)) + & Min(0.0,qrcev(mgs)) + Min(0.0,qhcev(mgs)) + Min(0.0,qscev(mgs)) + Min(0.0,qhlcev(mgs)) & + + Min(0.0,qfcev(mgs)) ! NOTE: pdep is the deposition part only pdep(mgs) = & & il5(mgs)*( & @@ -18827,7 +23022,7 @@ subroutine nssl_2mom_gs & & + qidpv(mgs) + qisbv(mgs) ) & & +il5(mgs)*(qiint(mgs)) pvap(mgs) = & - & qrcev(mgs) + qhcev(mgs) + qhlcev(mgs) ! + qscev(mgs) + & qrcev(mgs) + qhcev(mgs) + qhlcev(mgs) + qfcev(mgs) ELSE pfrz(mgs) = 0.0 psub(mgs) = 0.0 @@ -18855,6 +23050,8 @@ subroutine nssl_2mom_gs & ! ! do mgs = 1,ngscnt + + qwvp(mgs) = qwvp(mgs) + & & dtp*(pqwvi(mgs)+pqwvd(mgs)) qx(mgs,lc) = qx(mgs,lc) + & @@ -18867,6 +23064,7 @@ subroutine nssl_2mom_gs & & dtp*(pqswi(mgs)+pqswd(mgs)) qx(mgs,lh) = qx(mgs,lh) + & & dtp*(pqhwi(mgs)+pqhwd(mgs)) + IF ( lhl .gt. 1 ) THEN qx(mgs,lhl) = qx(mgs,lhl) + & & dtp*(pqhli(mgs)+pqhld(mgs)) @@ -18936,12 +23134,32 @@ subroutine nssl_2mom_gs & + ENDIF + ENDIF + IF ( ipconc .ge. 6 ) THEN + IF ( lzr .gt. 1 ) THEN + zx(mgs,lr) = zx(mgs,lr) + & + & dtp*(pzrwi(mgs)+pzrwd(mgs)) + ENDIF + IF ( lzs .gt. 1 ) THEN + zx(mgs,ls) = zx(mgs,ls) + & + & dtp*(pzswi(mgs)+pzswd(mgs)) + ENDIF + IF ( lzh .gt. 1 ) THEN + zx(mgs,lh) = zx(mgs,lh) + & + & dtp*(pzhwi(mgs)+pzhwd(mgs)) + ENDIF + IF ( lzhl .gt. 1 ) THEN + zx(mgs,lhl) = zx(mgs,lhl) + & + & dtp*(pzhli(mgs)+pzhld(mgs)) +! IF ( pchli(mgs) .ne. 0. .or. pchld(mgs) .ne. 0 ) THEN +! write(0,*) 'dr: cx,pchli,pchld = ', cx(mgs,lhl),pchli(mgs),pchld(mgs), igs(mgs),kgs(mgs) +! ENDIF ENDIF ENDIF end do end if - IF ( has_wetscav ) THEN DO mgs = 1,ngscnt evapprod2d(igs(mgs),kgs(mgs)) = -(qrcev(mgs) + qssbv(mgs) + qhsbv(mgs) + qhlsbv(mgs)) @@ -19183,41 +23401,9 @@ subroutine nssl_2mom_gs & tqvcon = temg(mgs)-cbw ltemq = (temg(mgs)-163.15)/fqsat+1.5 ltemq = Min( nqsat, Max(1,ltemq) ) -! IF ( ltemq .lt. 1 .or. ltemq .gt. nqsat ) THEN -! C$PAR CRITICAL SECTION -! write(iunit,*) 'out of range ltemq!',temgtmp,temg(mgs), -! : thetap(mgs),theta0(mgs),pres(mgs),theta(mgs), -! : ltemq,igs(mgs),jy,kgs(mgs) -! write(iunit,*) an(igs(mgs),jy,kgs(mgs),lt), -! : ab(igs(mgs),jy,kgs(mgs),lt), -! : t0(igs(mgs),jy,kgs(mgs)) -! write(iunit,*) fcc3(mgs),qx(mgs,lc),qitmp(mgs),dtp,ptem(mgs) -! STOP -! C$PAR END CRITICAL SECTION -! END IF + qvs(mgs) = pqs(mgs)*tabqvs(ltemq) qis(mgs) = pqs(mgs)*tabqis(ltemq) -! qss(kz) = qvs(kz) -! if ( temg(kz) .lt. tfr ) then -! if( qcw(kz) .le. qxmin(lc) .and. qci(kz) .gt. qxmin(li)) -! > qss(kz) = qis(kz) -! if( qcw(kz) .gt. qxmin(lc) .and. qci(kz) .gt. qxmin(li)) -! > qss(kz) = (qcw(kz)*qvs(kz) + qci(kz)*qis(kz)) / -! > (qcw(kz) + qci(kz)) -! qss(kz) = qis(kz) -! end if -! dont get enough condensation with qcw .le./.gt. qxmin(lc) -! if ( temg(mgs) .lt. tfr ) then -! if( qx(mgs,lc) .ge. 0.0 .and. qitmp(mgs) .le. qxmin(li) ) -! > qss(mgs) = qvs(mgs) -! if( qx(mgs,lc) .eq. 0.0 .and. qitmp(mgs) .gt. qxmin(li)) -! > qss(mgs) = qis(mgs) -! if( qx(mgs,lc) .gt. 0.0 .and. qitmp(mgs) .gt. qxmin(li)) -! > qss(mgs) = (qx(mgs,lc)*qvs(mgs) + qitmp(mgs)*qis(mgs)) / -! > (qx(mgs,lc) + qitmp(mgs)) -! else -! qss(mgs) = qvs(mgs) -! end if qss(mgs) = qvs(mgs) if ( temg(mgs) .lt. tfr ) then if( qx(mgs,lc) .ge. 0.0 .and. qitmp(mgs) .le. qxmin(li) ) & @@ -19456,7 +23642,6 @@ subroutine nssl_2mom_gs & - if (ndebug .gt. 0 ) write(0,*) 'gs 11' do mgs = 1,ngscnt @@ -19487,6 +23672,29 @@ subroutine nssl_2mom_gs & ENDIF + + + +! +! 6th moments +! + + IF ( ipconc .ge. 6 ) THEN + DO il = lr,lhab + IF ( lz(il) .gt. 1 ) THEN + IF ( lf > 1 .and. il == lf ) THEN + lfsave(mgs,3) = an(igs(mgs),jy,kgs(mgs),lz(il)) + lfsave(mgs,4) = zx(mgs,il) + ENDIF + + an(igs(mgs),jy,kgs(mgs),lz(il)) = zx(mgs,il) + & + & min( an(igs(mgs),jy,kgs(mgs),lz(il)), 0.0 ) + zx(mgs,il) = an(igs(mgs),jy,kgs(mgs),lz(il)) + + ENDIF + ENDDO + + ENDIF ! end do ! @@ -19551,11 +23759,466 @@ subroutine nssl_2mom_gs & ENDIF !} ENDDO ! mgs + ELSE ! } { is three-moment, so have to adjust Z if size is too large + IF ( il == lr .and. imurain == 3 ) THEN ! { { RAIN + +! rdmx = +! rdmn = + + DO mgs = 1,ngscnt + + + IF ( iresetmoments == 1 .or. iresetmoments == il ) THEN + IF ( zx(mgs,lr) <= zxmin ) THEN + qx(mgs,lv) = qx(mgs,lv) + qx(mgs,il) + qx(mgs,lr) = 0.0 + cx(mgs,lr) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),lr) + an(igs(mgs),jgs,kgs(mgs),lr) = qx(mgs,lr) + an(igs(mgs),jgs,kgs(mgs),ln(lr)) = cx(mgs,lr) + ELSEIF ( cx(mgs,lr) <= cxmin ) THEN + qx(mgs,lv) = qx(mgs,lv) + qx(mgs,il) + zx(mgs,lr) = 0.0 + qx(mgs,lr) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),lr) + an(igs(mgs),jgs,kgs(mgs),lr) = qx(mgs,lr) + an(igs(mgs),jgs,kgs(mgs),lz(lr)) = zx(mgs,lr) + ENDIF + ENDIF + + IF ( qx(mgs,lr) .gt. qxmin(lr) ) THEN + + xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xdn(mgs,lr)*Max(1.0e-11,cx(mgs,lr))) + IF ( xv(mgs,lr) .gt. xvmx(lr) ) THEN +! xv(mgs,lr) = xvmx(lr) +! cx(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xvmx(lr)*xdn(mgs,lr)) + ELSEIF ( xv(mgs,lr) .lt. xvmn(lr) ) THEN + xv(mgs,lr) = xvmn(lr) + cx(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xvmn(lr)*xdn(mgs,lr)) + ENDIF + + IF ( zx(mgs,il) > 0.0 .and. cx(mgs,il) <= 0.0 ) THEN +! have mass and reflectivity but no concentration, so set concentration, using default alpha + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + z = zx(mgs,il) + qr = qx(mgs,il) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z*xdn(mgs,lr)**2) +! an(igs(mgs),jgs,kgs(mgs),ln(il)) = zx(mgs,il) + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) > 0.0 ) THEN +! have mass and concentration but no reflectivity, so set reflectivity, using default alpha + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + chw = cx(mgs,il) + qr = qx(mgs,il) + zx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(xdn(mgs,lr)**2*chw) + an(igs(mgs),jgs,kgs(mgs),lz(lr)) = zx(mgs,lr) + + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= 0.0 ) THEN +! How did this happen? + ! set values according to dBZ of -10, or Z = 0.1 +! 0.1 = 1.e18*0.224*an(ix,jy,kz,lzh)*(hwdn/rwdn)**2 + zx(mgs,il) = 1.e-19/0.224*(xdn0(lr)/xdn0(il))**2 + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + z = zx(mgs,il) + qr = qx(mgs,il) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z*1000.*1000) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ENDIF + + IF ( zx(mgs,lr) > 0.0 ) THEN + xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(1000.*cx(mgs,lr)) + vr = xv(mgs,lr) + qr = qx(mgs,lr) + nrx = cx(mgs,lr) + z = zx(mgs,lr) + +! xv = (db(1,kz)*a(1,1,kz,lr))**2/(a(1,1,kz,lnr)) +! rd = z*(pi/6.*1000.)**2/xv + +! determine shape parameter alpha by iteration + IF ( z .gt. 0.0 ) THEN + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. + DO i = 1,20 + IF ( Abs(alp - alpha(mgs,lr)) .lt. 0.01 ) EXIT + alpha(mgs,lr) = Max( rnumin, Min( rnumax, alp ) ) + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. + alp = Max( rnumin, Min( rnumax, alp ) ) + ENDDO + +! check for artificial breakup (rain larger than allowed max size) + IF ( xv(mgs,il) .gt. xvmx(il) .or. (ioldlimiter == 2 .and. xv(mgs,il) .gt. xvmx(il)/8.) ) THEN + tmp = cx(mgs,il) +! write(0,*) 'MY limiter: xv: ',xv(mgs,il), xv(mgs,il)/(xvmx(il)/8.) +! STOP + IF ( ioldlimiter == 2 ) THEN ! MY-style active breakup + x = (6.*rho0(mgs)*qx(mgs,il)/(pi*xdn(mgs,il)*cx(mgs,il)))**(1./3.) + x1 = Max(0.0e-3, x - 3.0e-3) + x2 = Max(0.5, x/6.0e-3) + x3 = x2**3 + cx(mgs,il) = cx(mgs,il)*Max((1.+2.222e3*x1**2), x3) + xv(mgs,il) = xv(mgs,il)/Max((1.+2.222e3*x1**2), x3) + ELSE ! simple cutoff + xv(mgs,il) = Min( xvmx(il), Max( xvmn(il),xv(mgs,il) ) ) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il)) + ENDIF + !xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + !cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il)) + + + IF ( tmp < cx(mgs,il) ) THEN ! breakup + + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + zx(mgs,il) = zx(mgs,il) + g1*(rho0(mgs)/xdn(mgs,il))**2*( (qx(mgs,il)/tmp)**2 * (tmp-cx(mgs,il)) ) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + vr = xv(mgs,lr) + qr = qx(mgs,lr) + nrx = cx(mgs,lr) + z = zx(mgs,lr) + + +! determine shape parameter alpha by iteration + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. + DO i = 1,20 + IF ( Abs(alp - alpha(mgs,lr)) .lt. 0.01 ) EXIT + alpha(mgs,lr) = Max( rnumin, Min( rnumax, alp ) ) + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. + alp = Max( rnumin, Min( rnumax, alp ) ) + ENDDO + + + ENDIF + ENDIF + +! +! Check whether the shape parameter is at or less than the minimum, and if it is, reset the +! concentration or reflectivity to match (prevents reflectivity from being out of balance with Q and N) +! + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + IF ( .true. .and. (alpha(mgs,il) <= rnumin .or. alp == rnumin .or. alp == rnumax) ) THEN + + IF ( rescale_high_alpha .and. alp >= rnumax - 0.01 ) THEN ! reset c at high alpha to prevent growth in Z + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z*(1./(xdn(mgs,il)))**2 + an(igs(mgs),jy,kgs(mgs),ln(il)) = cx(mgs,il) + + ELSEIF ( rescale_low_alphar .and. alp <= rnumin ) THEN + z = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/((alpha(mgs,lr)+1.0)*pi**2) + zx(mgs,il) = z + an(igs(mgs),jy,kgs(mgs),lz(il)) = zx(mgs,il) + ENDIF + ENDIF + + + + ENDIF + ENDIF + + ENDIF + + ENDDO +! CALL cld_cpu('Z-MOMENT-1r') + + + ELSEIF ( il == lh .or. il == lhl .or. il == lf .or. (il == lr .and. imurain == 1 )) THEN ! } { Rain, GRAUPEL OR HAIL + + + + DO mgs = 1,ngscnt + + IF ( lf > 1 .and. il == lf ) THEN + lfsave(mgs,5) = an(igs(mgs),jy,kgs(mgs),ln(il)) + lfsave(mgs,6) = cx(mgs,il) + ENDIF + + IF ( il == lhl .and. lnhlf > 1 ) THEN + IF ( cx(mgs,lhl) > cxmin ) THEN + frac = chxf(mgs,lhl)/cx(mgs,lhl) + ELSE + frac = 0.0 + ENDIF + ENDIF + + IF ( il == lh .and. lnhf > 1 ) THEN + IF ( cx(mgs,lh) > cxmin ) THEN + frach = chxf(mgs,lh)/cx(mgs,lh) + ELSE + frach = 0.0 + ENDIF + ENDIF + + + + IF ( iresetmoments == 1 .or. iresetmoments == il .or. iresetmoments == -1 ) THEN ! { .or. qx(mgs,il) <= qxmin(il) + IF ( zx(mgs,il) <= zxmin ) THEN ! .and. qx(mgs,il) > 0.05e-3 +!! write(91,*) 'zx=0; qx,cx = ',1000.*qx(mgs,il),cx(mgs,il) + qx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ELSEIF ( iresetmoments == -1 .and. qx(mgs,il) < qxmin(il) ) THEN + zx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + ELSEIF ( cx(mgs,il) <= cxmin .and. iresetmoments /= -1 ) THEN ! .and. qx(mgs,il) > 0.05e-3 + qx(mgs,lv) = qx(mgs,lv) + qx(mgs,il) + zx(mgs,il) = 0.0 + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + ENDIF + ELSE + IF ( zx(mgs,il) < 0.0 ) THEN ! .and. qx(mgs,il) > 0.05e-3 + zx(mgs,il) = 0.0 + ENDIF + ENDIF !} + + + IF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= cxmin ) THEN + zx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + ENDIF + + IF ( qx(mgs,il) .gt. qxmin(il) ) THEN !{ + + xv(mgs,il) = rho0(mgs)*qx(mgs,il)/(xdn(mgs,il)*Max(1.0e-9,cx(mgs,il))) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + + IF ( xv(mgs,il) .lt. xvmn(il) ) THEN + xv(mgs,il) = Min( xvmx(il), Max( xvmn(il),xv(mgs,il) ) ) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il)) + ENDIF + + IF ( zx(mgs,il) > 0.0 .and. cx(mgs,il) <= 0.0 ) THEN !{ +! have mass and reflectivity but no concentration, so set concentration, using default alpha + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + z = zx(mgs,il) + qr = qx(mgs,il) +! cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(6.*qr)**2/(z*(pi*xdn(mgs,il))**2) + + + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) > 0.0 ) THEN +! have mass and concentration but no reflectivity, so set reflectivity, using default alpha +! g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & +! & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + chw = cx(mgs,il) + qr = qx(mgs,il) +! zx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/chw +! zx(mgs,il) = Min(zxmin*1.1, g1*dn(igs(mgs),jy,kgs(mgs))**2*(6.*qr)**2/(chw*(pi*xdn(mgs,il))**2) ) + g1 = (6.0 + alphamax)*(5.0 + alphamax)*(4.0 + alphamax)/ & + & ((3.0 + alphamax)*(2.0 + alphamax)*(1.0 + alphamax)) + zx(mgs,il) = Max(zxmin*1.1, g1*dn(igs(mgs),jy,kgs(mgs))**2*(6*qr)**2/(chw*(pi*xdn(mgs,il))**2) ) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= 0.0 ) THEN +! How did this happen? + ! set values according to dBZ of -10, or Z = 0.1 +! 0.1 = 1.e18*0.224*an(ix,jy,kz,lzh)*(hwdn/rwdn)**2 + +! write(0,*) 'GS: moment problem! il,c,z,q = ',il,cx(mgs,il),zx(mgs,il),qx(mgs,il) + + zx(mgs,il) = 1.e-19/0.224*(xdn0(lr)/xdn0(il))**2 + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + z = zx(mgs,il) + qr = qx(mgs,il) +! cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(6.*qr)**2/(z*(pi*xdn(mgs,il))**2) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + +! write(0,*) 'GS: moment problem! reset il,c,z,q = ',il,cx(mgs,il),zx(mgs,il),qx(mgs,il) + + ELSE + ! have all valid moments, so find shape parameter + chw = cx(mgs,il) + qr = qx(mgs,il) + z = zx(mgs,il) + + IF ( zx(mgs,il) .gt. 0. ) THEN !{ + +! rdi = z*(pi/6.*1000.)**2*chw/((rho0(mgs)*qr)**2) + rdi = z*(pi/6.*xdn(mgs,il))**2*chw/((rho0(mgs)*qr)**2) + +! alp = 1.e18*(6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ +! : ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 + alp = (6.0+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 +! print*,'kz, alp, alpha(mgs,il) = ',kz,alp,alpha(mgs,il),rdi,z,xv + DO i = 1,10 +! IF ( 100.*Abs(alp - alpha(mgs,il))/(Abs(alpha(mgs,il))+1.e-5) .lt. 1. ) EXIT + IF ( Abs(alp - alpha(mgs,il)) .lt. 0.01 ) EXIT + alpha(mgs,il) = Max( alphamin, Min( alphamax, alp ) ) +! alp = 1.e18*(6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ +! : ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 + alp = (6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 +! print*,'i,alp = ',i,alp + alp = Max( alphamin, Min( alphamax, alp ) ) + ENDDO + + +! check for artificial breakup (graupel/hail larger than allowed max size) + IF ( xv(mgs,il) .gt. xvmx(il) ) THEN !{ + tmp = cx(mgs,il) + + + xv(mgs,il) = Min( xvmx(il), Max( xvmn(il),xv(mgs,il) ) ) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il)) + IF ( tmp < cx(mgs,il) ) THEN ! breakup + g1 = 36.*(6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))*pi**2) + zx(mgs,il) = zx(mgs,il) + g1*(rho0(mgs)/xdn(mgs,il))**2*( (qx(mgs,il)/tmp)**2 * (tmp-cx(mgs,il)) ) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + chw = cx(mgs,il) + qr = qx(mgs,il) + z = zx(mgs,il) + + rdi = z*(pi/6.*xdn(mgs,il))**2*chw/((rho0(mgs)*qr)**2) + alp = (6.0+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 + DO i = 1,10 + IF ( Abs(alp - alpha(mgs,il)) .lt. 0.01 ) EXIT + alpha(mgs,il) = Max( alphamin, Min( alphamax, alp ) ) + alp = (6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 + alp = Max( alphamin, Min( alphamax, alp ) ) + ENDDO + + + ENDIF + ENDIF !} + +! +! Check whether the shape parameter is at or less than the minimum, and if it is, reset the +! concentration or reflectivity to match (prevents reflectivity from being out of balance with Q and N) +! + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + + IF ( ( lrescalelow(il) .or. rescale_high_alpha ) .and. & + & ( alpha(mgs,il) <= alphamin .or. alp == alphamin .or. alp == alphamax ) ) THEN !{ + + IF ( rescale_high_alpha .and. alp >= alphamax - 0.01 ) THEN ! reset c at high alpha to prevent growth in Z + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z*(6./(pi*xdn(mgs,il)))**2 + an(igs(mgs),jy,kgs(mgs),ln(il)) = cx(mgs,il) + + ELSEIF ( lrescalelow(il) .and. alp <= alphamin .and. .not. (il == lh .and. icvhl2h > 0 ) .and. & + .not. ( il == lr .and. .not. rescale_low_alphar ) ) THEN ! alpha = alphamin, so reset Z to prevent growth in C + + wtest = .false. + IF ( irescalerainopt == 0 ) THEN + wtest = .false. + ELSEIF ( irescalerainopt == 1 ) THEN + wtest = qx(mgs,lc) > qxmin(lc) + ELSEIF ( irescalerainopt == 2 ) THEN + wtest = qx(mgs,lc) > qxmin(lc) .and. wvel(mgs) < rescale_wthresh + ELSEIF ( irescalerainopt == 3 ) THEN + wtest = temcg(mgs) > rescale_tempthresh .and. qx(mgs,lc) > qxmin(lc) .and. wvel(mgs) < rescale_wthresh + ENDIF + + IF ( il == lr .and. ( wtest .or. .not. rescale_low_alphar ) ) THEN + ! certain situations where rain number is adjusted instead of Z. Helps avoid rain being 'zapped' by autoconverted + ! drops (i.e., favor preserving Z when alpha tries to go negative) + chw = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z*(6./(pi*xdn(mgs,il)))**2 ! g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z1 + cx(mgs,il) = chw + an(igs(mgs),jy,kgs(mgs),ln(il)) = chw + ELSE + ! Usual resetting of reflectivity moment to force consisntency between Q, N, Z, and alpha when alpha = alphamin + z1 = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/chw + z = z1*(6./(pi*xdn(mgs,il)))**2 + zx(mgs,il) = z + an(igs(mgs),jy,kgs(mgs),lz(il)) = z + ENDIF + +! z1 = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/chw +! z = z1*(6./(pi*xdn(mgs,il)))**2 +! zx(mgs,il) = z +! an(igs(mgs),jy,kgs(mgs),lz(il)) = z + ENDIF + + ENDIF !} + + ENDIF !} + + + ENDIF ! !} + + + + ENDIF !} + + IF ( lzr > 1 ) THEN + alpha2d(igs(mgs),kgs(mgs),1) = Max(alphamin, Min(alphamax, alpha(mgs,lr) )) + ENDIF + IF ( lzh > 1 ) THEN + alpha2d(igs(mgs),kgs(mgs),2) = Max(alphamin, Min(alphamax, alpha(mgs,lh) )) + ENDIF + IF ( lzhl > 1 ) THEN + alpha2d(igs(mgs),kgs(mgs),3) = Max(alphamin, Min(alphamax, alpha(mgs,lhl) )) + ENDIF + + IF ( il == lhl .and. lnhlf > 1 ) THEN + ! update chxf in case cx has changed + chxf(mgs,lhl) = frac*cx(mgs,lhl) + ENDIF + IF ( il == lh .and. lnhf > 1 ) THEN + ! update chxf in case cx has changed + chxf(mgs,lh) = frach*cx(mgs,lh) + ENDIF + + +! IF ( lf > 0 .and. il == lf .and. kgs(mgs) <= 20 .and. ( cx(mgs,lf) + dtp*( pcfwi(mgs) + pcfwd(mgs) ) > 200. .or. cx(mgs,lf) > 400. )) THEN +! write(0,*) 'ix,jy, kz, cf = ',igs(mgs)+ixbeg,jy+jybeg,kgs(mgs), an(igs(mgs),jy,kgs(mgs),ln(lf)),lfsave(mgs,5),lfsave(mgs,6) +! write(0,*) 'qold,qxold,zold,zxold = ',lfsave(mgs,1),lfsave(mgs,2),lfsave(mgs,3),lfsave(mgs,4) +! write(0,*) 'cf_new,pcfwi,pcfwd = ',cx(mgs,lf),cx(mgs,lf) + dtp*( pcfwi(mgs) + pcfwd(mgs) ),pcfwi(mgs) + pcfwd(mgs) +! +! ENDIF + + ENDDO ! mgs + +! CALL cld_cpu('Z-DELABK') + + +! CALL cld_cpu('Z-DELABK') + + + + + ENDIF ! } } + ENDIF ! }} ENDIF ! } DO mgs = 1,ngscnt + + IF ( il == lh ) THEN + IF ( lnhf > 1 ) THEN ! number of graupel from frozen drops + an(igs(mgs),jy,kgs(mgs),lnhf) = Max( chxf(mgs,lh), 0.0) + ENDIF + ENDIF + IF ( il == lhl ) THEN IF ( lnhlf > 1 ) THEN ! number of hail from frozen drops diff --git a/phys/module_physics_init.F b/phys/module_physics_init.F index e26df70a7d..42dd4f0609 100644 --- a/phys/module_physics_init.F +++ b/phys/module_physics_init.F @@ -233,15 +233,6 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf, & t00, p00, tlp, & !for obs-nudging TYR,TYRA,TDLY,TLAG,NYEAR,NDAY,tmn_update, & ACHFX,ACLHF,ACGRDFLX, & - nssl_cccn, & - nssl_alphah,nssl_alphahl, & - nssl_cnoh, nssl_cnohl, & - nssl_cnor, nssl_cnos, & - nssl_rho_qh, nssl_rho_qhl, & - nssl_rho_qs, & -! next 2 flags for Explicit lightning: - nssl_ipelec, & - nssl_isaund, & ! OPTIONAL RQCNCUTEN, RQINCUTEN, & rliq, & !BSINGH:01/31/2013 - Added rliq and is_CAMMGMP_used for CAM5 physics @@ -825,13 +816,6 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf, & TYPE(fdob_type), OPTIONAL, INTENT(INOUT) :: fdob #endif REAL, OPTIONAL, INTENT(IN) :: p00, t00, tlp ! for obs-nudging base-state calcn - REAL, INTENT(IN) :: nssl_cccn, nssl_alphah, nssl_alphahl, & - nssl_cnoh, nssl_cnohl, & - nssl_cnor, nssl_cnos, & - nssl_rho_qh, nssl_rho_qhl, & - nssl_rho_qs - - INTEGER, INTENT(IN) :: nssl_ipelec,nssl_isaund ! WA 12/21/09 REAL,OPTIONAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , & @@ -1019,9 +1003,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf, & (config_flags%ra_sw_physics .eq. goddardswscheme ) ) .and. & (config_flags%mp_physics .eq. THOMPSON .or. & config_flags%mp_physics .eq. THOMPSONAERO .or. & - config_flags%mp_physics .eq. NSSL_2MOM .or. & - config_flags%mp_physics .eq. NSSL_2MOMG .or. & - config_flags%mp_physics .eq. NSSL_2MOMCCN .or. & + (config_flags%mp_physics .eq. NSSL_2MOM .and. config_flags%nssl_2moment_on == 1) .or. & config_flags%mp_physics .eq. WSM3SCHEME .or. & config_flags%mp_physics .eq. WSM5SCHEME .or. & config_flags%mp_physics .eq. WSM6SCHEME .or. & @@ -1657,12 +1639,6 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf, & allowed_to_read, start_of_simulation, & !CAMMGMP specific variables ixcldliq, ixcldice, ixnumliq, ixnumice, & - nssl_cccn, nssl_alphah, nssl_alphahl, & - nssl_ipelec, nssl_isaund, & - nssl_cnoh, nssl_cnohl, & - nssl_cnor, nssl_cnos, & - nssl_rho_qh, nssl_rho_qhl, & - nssl_rho_qs, & ccn_conc, & ! RAS z_at_q, inv_dens, qnwfa2d, qnbca2d, & ! G. Thompson frc_urb2d, scalar, num_sc, & ! G. Thompson @@ -4390,12 +4366,6 @@ SUBROUTINE mp_init(RAINNC,SNOWNC,GRAUPELNC,config_flags,restart,warm_rain, allowed_to_read, start_of_simulation, & !CAMMGMP specific variables ixcldliq, ixcldice, ixnumliq, ixnumice, & - nssl_cccn, nssl_alphah, nssl_alphahl, & - nssl_ipelec, nssl_isaund, & - nssl_cnoh, nssl_cnohl, & - nssl_cnor, nssl_cnos, & - nssl_rho_qh, nssl_rho_qhl, & - nssl_rho_qs, & ccn_conc, & ! RAS z_at_q, inv_dens, qnwfa2d, qnbca2d, & ! G. Thompson frc_urb2d, scalar, num_sc, & ! G. Thompson @@ -4425,7 +4395,9 @@ SUBROUTINE mp_init(RAINNC,SNOWNC,GRAUPELNC,config_flags,restart,warm_rain, USE module_mp_wdm5 USE module_mp_wdm6 USE module_mp_wdm7 +#if (WRFPLUS != 1) & !defined( VAR4D ) USE module_mp_nssl_2mom, only: nssl_2mom_init +#endif #if (EM_CORE==1) USE module_mp_cammgmp_driver, ONLY:CAMMGMP_INIT !CAM5's microphysics USE module_mp_morr_two_moment_aero !TWG2017 @@ -4439,12 +4411,6 @@ SUBROUTINE mp_init(RAINNC,SNOWNC,GRAUPELNC,config_flags,restart,warm_rain, LOGICAL , INTENT(IN) :: restart LOGICAL , INTENT(OUT) :: warm_rain,adv_moist_cond REAL , INTENT(IN) :: MPDT, DT, DX, DY - REAL, INTENT(IN), OPTIONAL :: nssl_cccn, nssl_alphah, nssl_alphahl, & - nssl_cnoh, nssl_cnohl, & - nssl_cnor, nssl_cnos, & - nssl_rho_qh, nssl_rho_qhl, & - nssl_rho_qs - INTEGER, INTENT(IN), OPTIONAL :: nssl_ipelec, nssl_isaund LOGICAL , INTENT(IN) :: start_of_simulation INTEGER , INTENT(IN) :: ixcldliq, ixcldice, ixnumliq, ixnumice ! CAMMGMP specific variables @@ -4476,7 +4442,8 @@ SUBROUTINE mp_init(RAINNC,SNOWNC,GRAUPELNC,config_flags,restart,warm_rain, ! Local INTEGER :: i, j, itf, jtf REAL, DIMENSION(20) :: nssl_params - INTEGER :: nssl_ipelec_tmp + INTEGER :: nssl_ipelec_tmp, nssl_ipconc + logical :: nssl_density_on INTEGER :: i_err warm_rain = .false. @@ -4494,33 +4461,6 @@ SUBROUTINE mp_init(RAINNC,SNOWNC,GRAUPELNC,config_flags,restart,warm_rain, ENDDO ENDIF - IF ( present( nssl_cccn ) ) THEN - SELECT CASE(config_flags%mp_physics) - CASE (NSSL_2MOM,NSSL_2MOMCCN) - IF ( config_flags%elec_physics > 0 ) THEN - nssl_ipelec_tmp = nssl_ipelec - ELSE - nssl_ipelec_tmp = 0.0 - ENDIF - CASE DEFAULT - nssl_ipelec_tmp = 0.0 - END SELECT - - nssl_params(1) = nssl_cccn - nssl_params(2) = nssl_alphah - nssl_params(3) = nssl_alphahl - nssl_params(4) = nssl_cnoh - nssl_params(5) = nssl_cnohl - nssl_params(6) = nssl_cnor - nssl_params(7) = nssl_cnos - nssl_params(8) = nssl_rho_qh - nssl_params(9) = nssl_rho_qhl - nssl_params(10) = nssl_rho_qs - nssl_params(11) = nssl_ipelec_tmp - nssl_params(12) = nssl_isaund - - ENDIF - mp_select: SELECT CASE(config_flags%mp_physics) CASE (KESSLERSCHEME) @@ -4653,17 +4593,53 @@ SUBROUTINE mp_init(RAINNC,SNOWNC,GRAUPELNC,config_flags,restart,warm_rain, END IF # endif #endif - CASE (NSSL_1MOMLFO) - CALL nssl_2mom_init(ims,ime, jms,jme, kms,kme,nssl_params,ipctmp=0,mixphase=0,ihvol=-1) ! no separate hail - CASE (NSSL_1MOM) - CALL nssl_2mom_init(ims,ime, jms,jme, kms,kme,nssl_params,ipctmp=0,mixphase=0,ihvol=0) CASE (NSSL_2MOM) - CALL nssl_2mom_init(ims,ime, jms,jme, kms,kme,nssl_params,ipctmp=5,mixphase=0,ihvol=1) - CASE (NSSL_2MOMG) - CALL nssl_2mom_init(ims,ime, jms,jme, kms,kme,nssl_params,ipctmp=5,mixphase=0,ihvol=-1) ! turn off hail - CASE (NSSL_2MOMCCN) - ccn_conc = nssl_cccn/1.225 ! set this to have correct boundary conditions - CALL nssl_2mom_init(ims,ime, jms,jme, kms,kme,nssl_params,ipctmp=5,mixphase=0,ihvol=1) +! Single generalized case (mp_physics=18) replaces previously separate mp_physics values of 17,18,19,20,22 +#if (WRFPLUS != 1) & !defined( VAR4D ) + + IF ( config_flags%elec_physics > 0 ) THEN + nssl_ipelec_tmp = config_flags%nssl_ipelec + ELSE + nssl_ipelec_tmp = 0.0 + ENDIF + + nssl_params(:) = 0 + nssl_params(1) = config_flags%nssl_cccn + nssl_params(2) = config_flags%nssl_alphah + nssl_params(3) = config_flags%nssl_alphahl + nssl_params(4) = config_flags%nssl_cnoh + nssl_params(5) = config_flags%nssl_cnohl + nssl_params(6) = config_flags%nssl_cnor + nssl_params(7) = config_flags%nssl_cnos + nssl_params(8) = config_flags%nssl_rho_qh + nssl_params(9) = config_flags%nssl_rho_qhl + nssl_params(10) = config_flags%nssl_rho_qs + nssl_params(11) = nssl_ipelec_tmp + nssl_params(12) = config_flags%nssl_isaund + nssl_params(13) = 0 ! reserved + nssl_params(14) = 0 ! reserved + nssl_params(15) = 0 ! reserved + + IF ( config_flags%nssl_2moment_on == 0 ) THEN + nssl_ipconc = 0 + ELSE + IF ( config_flags%nssl_3moment > 0 ) THEN + nssl_ipconc = 8 + ELSE + nssl_ipconc = 5 + ENDIF + ENDIF + + IF ( config_flags % nssl_ccn_on > 0 ) THEN + ccn_conc = config_flags%nssl_cccn/1.225 ! set this to have correct boundary conditions + ENDIF + CALL nssl_2mom_init(nssl_params=nssl_params,ipctmp=nssl_ipconc,mixphase=0, & + nssl_density_on=(config_flags%nssl_density_on > 0), & + nssl_hail_on=config_flags%nssl_hail_on > 0, & + nssl_ccn_on=(config_flags%nssl_ccn_on > 0), & + nssl_icdx=config_flags%nssl_icdx, & + nssl_icdxhl=config_flags%nssl_icdxhl,ccn_is_ccna=config_flags%nssl_ccn_is_ccna) +#endif #if (EM_CORE==1) CASE (CAMMGMPSCHEME) ! CAM5's microphysics CALL CAMMGMP_INIT(ixcldliq, ixcldice, ixnumliq, ixnumice & diff --git a/run/README.namelist b/run/README.namelist index 4efccbe253..c7dc6cdf64 100644 --- a/run/README.namelist +++ b/run/README.namelist @@ -487,26 +487,15 @@ Namelist variables for controlling the adaptive time step option: = 13, SBU_YLIN scheme = 14, WDM 5-class scheme = 16, WDM 6-class scheme - = 17, NSSL 2-moment 4-ice scheme (steady background CCN) - = 18, NSSL 2-moment 4-ice scheme with predicted CCN (better for idealized than real cases) - to set a global CCN value, use - nssl_cccn = 0.7e9 ; CCN for NSSL scheme (18). - Also sets same value to ccn_conc for mp_physics=18 - = 19, NSSL 1-moment (7 class: qv,qc,qr,qi,qs,qg,qh; predicts graupel density) - = 21, NSSL 1-moment, (6-class), very similar to Gilmore et al. 2004 - Can set intercepts and particle densities in physics namelist, e.g., nssl_cnor + = 18, NSSL 2-moment 4-ice scheme with predicted (unactivated) CCN (or activated CCN) + to change global CCN value, use + nssl_cccn = 0.7e9 ; CCN (#/m^3 at sea level pressure) for NSSL scheme (18) or nssl_ccn_on=1 + Also sets ccn_conc for mp_physics=18 For NSSL 1-moment schemes, intercept and particle densities can be set for snow, graupel, hail, and rain. For the 1- and 2-moment schemes, the shape parameters for graupel and hail can be set. - nssl_alphah = 0. ! shape parameter for graupel - nssl_alphahl = 2. ! shape parameter for hail - nssl_cnoh = 4.e5 ! graupel intercept - nssl_cnohl = 4.e4 ! hail intercept - nssl_cnor = 8.e5 ! rain intercept - nssl_cnos = 3.e6 ! snow intercept - nssl_rho_qh = 500. ! graupel density - nssl_rho_qhl = 900. ! hail density - nssl_rho_qs = 100. ! snow density + PLEASE SEE README.NSSLmp for options affecting the NSSL scheme + = 17, 19, 21, 22: Legacy NSSL-MP options: see README.NSSLmp for equivalent settings with 18 = 24, WSM 7-class scheme (separate hail and graupel categories) = 26, WDM 7-class scheme (separate hail and graupel categories) = 28, aerosol-aware Thompson scheme with water- and ice-friendly aerosol climatology @@ -571,14 +560,14 @@ Namelist variables for controlling the adaptive time step option: acc_phy_tend = 0 ! set to =1 to output 16 accumulated physics tendencies for potential temp, water vaopr mixing ratio, and U/V wind components; default is 0=off (new in 4.4) progn (max_dom) = 0 ! switch to use mix-activate scheme (Only for Morrison, WDM6, WDM5, - and NSSL_2MOMCCN/NSSL_2MOM - ccn_conc = 1.E8 ! CCN concentration, used by WDM schemes + and NSSL_2MOM) + ccn_conc = 1.E8 ! CCN concentration, used by WDM schemes (set automatically for NSSL_2MOM using nssl_cccn) no_mp_heating = 0 ! normal = 1 ! turn off latent heating from a microphysics scheme use_mp_re = 1 ! whether to use effective radii computed in mp schemes in RRTMG 0: do not use; 1: use effective radii - (The mp schemes that compute effective radii are 3,4,6,7,8,10,14,16,17-21,24,26,28,50-53,55) + (The mp schemes that compute effective radii are 3,4,6,7,8,10,14,16,18,24,26,28,50-53,55) force_read_thompson = .false. ! whether to read tables for mp_physics = 8,28 write_thompson_tables = .true. ! whether to read or compute tables for mp_phyiscs = 8,28 @@ -1063,8 +1052,10 @@ Namelist variables for controlling the adaptive time step option: ua_phys = .false. ! Option to activate UA Noah changes: a different snow-cover physics in Noah, aimed particularly toward improving treatment of snow as it relates to the vegetation canopy. Also uses new columns added in VEGPARM.TBL - do_radar_ref = 0, ! 1 = allows radar reflectivity to be computed using mp-scheme-specific - parameters. Currently works for mp_physics = 2,4,6,7,8,10,14,16,24,26,28 + do_radar_ref = 0, ! 1 = allows radar reflectivity to be computed using mp-scheme-specific + parameters. Currently works for mp_physics = 2,4,6,7,8,10,14,16,24,26,28 + Note that reflectivity is always computed for mp_physics = 9,18, and is + also set =1 when nwp_diagnostics=1 hailcast_opt (max_dom) = 0, ! 1 = 1-D hail growth model which predicts 1st-5th rank-ordered hail diameters, mean hail diameter and standard deviation of hail diameter. (Adams-Selin and Ziegler, MWR Dec 2016.) haildt (max_dom) = 0., ! seconds between WRF-HAILCAST calls (s) diff --git a/share/module_check_a_mundo.F b/share/module_check_a_mundo.F index 1acb3bda82..ad653a9820 100644 --- a/share/module_check_a_mundo.F +++ b/share/module_check_a_mundo.F @@ -3352,6 +3352,98 @@ SUBROUTINE set_physics_rconfigs END IF +!----------------------------------------------------------------------- +! Check for deprecated options with NSSL-MP +!----------------------------------------------------------------------- + DO i = 1, model_config_rec % max_dom + IF ( .NOT. model_config_rec % grid_allowed(i) ) CYCLE + IF ( model_config_rec % mp_physics(i) .EQ. 22 ) THEN + model_config_rec % mp_physics(i) = NSSL_2MOM + model_config_rec % nssl_2moment_on = 1 + model_config_rec % nssl_hail_on(i) = 0 + model_config_rec % nssl_ccn_on = 0 + model_config_rec % nssl_density_on = 1 ! set graupel density + WRITE (wrf_err_message, FMT='(A)') ' **CAUTION** mp_physics = 22 has been deprecated. '// & + 'Instead you can use mp_physics=18, nssl_hail_on=0, nssl_ccn_on=0' + CALL wrf_debug ( 0, wrf_err_message ) + ELSEIF ( model_config_rec % mp_physics(i) .EQ. 17 ) THEN + model_config_rec % mp_physics(i) = NSSL_2MOM + model_config_rec % nssl_2moment_on = 1 + model_config_rec % nssl_hail_on(i) = 1 + model_config_rec % nssl_ccn_on = 0 + model_config_rec % nssl_density_on = 2 ! set graupel+hail density + WRITE (wrf_err_message, FMT='(A)') ' **CAUTION** mp_physics = 17 has been deprecated. '// & + 'Instead you can use mp_physics=18, nssl_ccn_on=0' + ! print statement for deprecated option + CALL wrf_debug ( 0, wrf_err_message ) + ELSEIF ( model_config_rec % mp_physics(i) .EQ. 19 ) THEN + ! single-moment with hail + graupel density + model_config_rec % mp_physics(i) = NSSL_2MOM + model_config_rec % nssl_2moment_on = 0 + model_config_rec % nssl_hail_on(i) = 2 + model_config_rec % nssl_density_on = 1 ! set graupel density + ! print statement for deprecated option + WRITE (wrf_err_message, FMT='(A)') ' **CAUTION** mp_physics = 19 has been deprecated. '// & + 'Instead you can use mp_physics=18, nssl_2moment_on=0, nssl_ccn_on=0' + CALL wrf_debug ( 0, wrf_err_message ) + ELSEIF ( model_config_rec % mp_physics(i) .EQ. 21 ) THEN + ! single-moment without + model_config_rec % mp_physics(i) = NSSL_2MOM + model_config_rec % nssl_2moment_on = 0 + model_config_rec % nssl_hail_on(i) = 0 + model_config_rec % nssl_density_on = 0 ! set graupel density + ! print statement for deprecated option + WRITE (wrf_err_message, FMT='(A)') ' **CAUTION** mp_physics = 21 has been deprecated. '// & + 'Instead you can use mp_physics=18, nssl_2moment_on=0, nssl_ccn_on=0, nssl_hail_on=0' + CALL wrf_debug ( 0, wrf_err_message ) + ENDIF + + IF ( model_config_rec % mp_physics(i) /= NSSL_2MOM ) THEN + ! If not NSSL-MP, make sure extra fields are turned off (in case of stray namelist settings) + model_config_rec % nssl_2moment_on = 0 + model_config_rec % nssl_hail_on(i) = 0 + model_config_rec % nssl_density_on = 0 ! set graupel density + model_config_rec % nssl_3moment = 0 + model_config_rec % nssl_ccn_on = 0 + + ELSE ! make sure settings are consistent + + IF ( model_config_rec % nssl_ccn_on < 0 ) THEN + model_config_rec % nssl_ccn_on = 1 + ENDIF + + IF ( model_config_rec % nssl_2moment_on < 0 ) THEN ! turn on number concentrations + model_config_rec % nssl_2moment_on = 1 + ENDIF + + IF ( model_config_rec % nssl_hail_on(i) < 0 ) THEN + IF ( model_config_rec % nssl_2moment_on == 0 ) THEN + model_config_rec % nssl_hail_on(i) = 2 + ELSE + model_config_rec % nssl_hail_on(i) = 1 + ENDIF + ENDIF + + IF ( model_config_rec % nssl_density_on < 0 ) THEN + IF ( model_config_rec % nssl_hail_on(i) == 1 ) THEN + model_config_rec % nssl_density_on = 2 ! set default of graupel+hail density + ELSE + model_config_rec % nssl_density_on = 1 ! set graupel density (hail off) + ENDIF + ENDIF + + IF ( model_config_rec % nssl_3moment == 1 ) THEN + model_config_rec % nssl_2moment_on = 1 + IF ( model_config_rec % nssl_hail_on(i) == 1 ) THEN + model_config_rec % nssl_3moment = 2 ! 3mom rain, graupel and hail + ELSE + model_config_rec % nssl_3moment = 1 ! 3mom rain and graupel (no hail) + ENDIF + ENDIF + ENDIF + + ENDDO + !----------------------------------------------------------------------- ! If a user requested to compute the radar reflectivity .OR. if this is ! one of the schemes that ALWAYS computes the radar reflectivity, then @@ -3361,16 +3453,11 @@ SUBROUTINE set_physics_rconfigs DO i = 1, model_config_rec % max_dom IF ( .NOT. model_config_rec % grid_allowed(i) ) CYCLE IF ( ( model_config_rec % mp_physics(i) .EQ. MILBRANDT2MOM ) .OR. & -#if (EM_CORE == 1) ( model_config_rec % mp_physics(i) .EQ. NSSL_2MOM ) .OR. & - ( model_config_rec % mp_physics(i) .EQ. NSSL_2MOMG ) .OR. & - ( model_config_rec % mp_physics(i) .EQ. NSSL_2MOMCCN ) .OR. & - ( model_config_rec % mp_physics(i) .EQ. NSSL_1MOM ) .OR. & - ( model_config_rec % mp_physics(i) .EQ. NSSL_1MOMLFO ) .OR. & -#endif ( model_config_rec % do_radar_ref .EQ. 1 ) ) THEN model_config_rec % compute_radar_ref = 1 - END IF + ENDIF + ENDDO !----------------------------------------------------------------------- diff --git a/wrftladj/module_microphysics_driver_ad.F b/wrftladj/module_microphysics_driver_ad.F index de436b2263..ead30bf2cc 100755 --- a/wrftladj/module_microphysics_driver_ad.F +++ b/wrftladj/module_microphysics_driver_ad.F @@ -55,8 +55,7 @@ SUBROUTINE A_MICROPHYSICS_DRIVER(th, thb, rho, rhob, pi_phy, pi_phyb, p& USE module_state_description, ONLY : & KESSLERSCHEME, LINSCHEME, SBU_YLINSCHEME, WSM3SCHEME, WSM5SCHEME & ,WSM6SCHEME, WSM6RSCHEME, ETAMPNEW, THOMPSON, MORR_TWO_MOMENT & - ,GSFCGCESCHEME, WDM5SCHEME, WDM6SCHEME, NSSL_2MOM, NSSL_2MOMCCN & - ,NSSL_1MOM,NSSL_1MOMLFO & ! ,NSSL_3MOM & + ,GSFCGCESCHEME, WDM5SCHEME, WDM6SCHEME, NSSL_2MOM & ,MILBRANDT2MOM, LSCONDSCHEME, MKESSLERSCHEME, CAMMGMPSCHEME, NTU !,MILBRANDT3MOM, ntu3m ! Model Layer @@ -77,7 +76,6 @@ SUBROUTINE A_MICROPHYSICS_DRIVER(th, thb, rho, rhob, pi_phy, pi_phyb, p& IMPLICIT NONE -! ,NSSL_3MOM & !,MILBRANDT3MOM ! Model Layer ! *** add new modules of schemes here diff --git a/wrftladj/module_microphysics_driver_tl.F b/wrftladj/module_microphysics_driver_tl.F index ea57bfbb4d..2562f4d5ae 100755 --- a/wrftladj/module_microphysics_driver_tl.F +++ b/wrftladj/module_microphysics_driver_tl.F @@ -51,8 +51,7 @@ SUBROUTINE G_MICROPHYSICS_DRIVER(th, thd, rho, rhod, pi_phy, pi_phyd, p& USE module_state_description, ONLY : & KESSLERSCHEME, LINSCHEME, SBU_YLINSCHEME, WSM3SCHEME, WSM5SCHEME & ,WSM6SCHEME, WSM6RSCHEME, ETAMPNEW, THOMPSON, MORR_TWO_MOMENT & - ,GSFCGCESCHEME, WDM5SCHEME, WDM6SCHEME, NSSL_2MOM, NSSL_2MOMCCN, NSSL_2MOMG & - ,NSSL_1MOM,NSSL_1MOMLFO & ! ,NSSL_3MOM & + ,GSFCGCESCHEME, WDM5SCHEME, WDM6SCHEME, NSSL_2MOM & ,MILBRANDT2MOM, LSCONDSCHEME, MKESSLERSCHEME, CAMMGMPSCHEME, NTU !,MILBRANDT3MOM, ntu3m ! Model Layer @@ -72,7 +71,6 @@ SUBROUTINE G_MICROPHYSICS_DRIVER(th, thd, rho, rhod, pi_phy, pi_phyd, p& IMPLICIT NONE -! ,NSSL_3MOM & !,MILBRANDT3MOM ! Model Layer ! *** add new modules of schemes here From 6156b78dfd350e0514d2455badcd7eab9b7d2d31 Mon Sep 17 00:00:00 2001 From: Cenlin_He Date: Tue, 23 Jan 2024 11:32:59 -0700 Subject: [PATCH 35/41] Update urban LCZ parameter table with more reasonable values (#1969) TYPE: enhancement KEYWORDS: urban, parameter SOURCE: Reported by Benjamin Fersch (Karlsruhe Institute of Technology, Germany), fixed by Alberto Martilli (CIEMAT, Spain) DESCRIPTION OF CHANGES: Problem: Current urban LCZ parameter table includes some unreasonable values for urban morphology (e.g., too large road width) and thermal properties (e.g., CAPR, CAPB, CAPG, AKSR, AKPB, AKPG). The LCZ classification is mainly a classification based on morphology, rather than thermal properties, so it should use the same thermal properties for different LCZs unless users have specific information from other local data sources. Solution: Use morphological parameters correspond to mid-range values of Stewart and Oke 2012, and all the LCZ classes have the same thermal properties. ISSUE: [For use when this PR closes an issue.](https://github.com/wrf-model/WRF/issues/1954) LIST OF MODIFIED FILES: URBPARM_LCZ.TBL TESTS CONDUCTED: 1. The mods fix the problem. 2. It passed regression tests. RELEASE NOTE: Update urban LCZ parameter table (URBPARM_LCZ.TBL) with more reasonable values. --- run/URBPARM_LCZ.TBL | 96 +++++++++++++++++++++++---------------------- 1 file changed, 49 insertions(+), 47 deletions(-) diff --git a/run/URBPARM_LCZ.TBL b/run/URBPARM_LCZ.TBL index 80e6809c17..450d765f9d 100644 --- a/run/URBPARM_LCZ.TBL +++ b/run/URBPARM_LCZ.TBL @@ -32,21 +32,21 @@ SIGMA_ZED: 4.0, 3.0, 1.0, 1., 1., 1., 1., 1., 1., 1., 1. # ROOF_WIDTH: Roof (i.e., building) width [ m ] # (sf_urban_physics=1) -ROOF_WIDTH: 31.7, 25.7, 17.6, 17.6, 17.6, 17.6, 17.6, 17.6, 17.6, 17.6, 10. +ROOF_WIDTH: 22.2, 22., 9.6, 42.86, 26.25, 13., 25., 28.9, 43.33, 23.8, 5. # # ROAD_WIDTH: road width [ m ] # (sf_urban_physics=1) # -ROAD_WIDTH: 98.9, 39.2, 108.0, 108.0, 108.0, 108.0, 108.0, 108.0, 108.0, 108.0, 108.0 +ROAD_WIDTH: 20., 14., 5.2, 50.0, 35.0, 13.0, 3.33, 32.5, 43.3, 28.6, 100.0 # # AH: Anthropogenic heat [ W m{-2} ] # (sf_urban_physics=1) # -AH: 100.0, 35.0, 30.0, 30.0, 15.0, 10.0, 30.0, 40.0, 5.0, 300.0, 0 +AH: 175.0, 37.5, 37.5, 25.0, 12.5, 12.5, 17.5, 25.0, 5.0, 350.0, 350.0 # @@ -54,7 +54,7 @@ AH: 100.0, 35.0, 30.0, 30.0, 15.0, 10.0, 30.0, 40.0, 5.0, 300.0, 0 # (sf_urban_physics=1) # -ALH: 20.0, 25.0, 40.0, 20.0, 25.0, 40.0, 20.0, 25.0, 40.0, 20.0, 0 +ALH: 20.0, 25.0, 40.0,20.0, 25.0, 40.0,20.0, 25.0, 40.0,20.0, 25.0 # # AKANDA_URBAN: Coefficient modifying the Kanda approach to computing @@ -232,90 +232,92 @@ DZGR: 0.05 0.10 0.15 0.20 # (sf_urban_physics=1,2,3) # -FRC_URB: 1.00, 0.99, 1.00, 0.65, 0.7, 0.65, 0.3, 0.85, 0.3, 0.55, 1.00 +FRC_URB: 0.95, 0.9,0.85, 0.65, 0.7, 0.6, 0.85, 0.85, 0.3, 0.55, 1.00 + # # CAPR: Heat capacity of roof [ J m{-3} K{-1} ] # (sf_urban_physics=1,2,3) # -CAPR: 1.8E6, 1.8E6, 1.44E6, 1.8E6, 1.8E6, 1.44E6, 2.0E6, 1.8E6, 1.44E6, 2.0E6, 1.8E6 +CAPR: 1.32E6,1.32E6,1.32E6, 1.32E6, 1.32E6, 1.32E6, 1.32E6, 1.32E6, 1.32E6, 1.32E6, 1.32E6 # # CAPB: Heat capacity of building wall [ J m{-3} K{-1} ] # (sf_urban_physics=1,2,3) # -CAPB: 1.8E6, 2.67E6, 2.05E6, 2.0E6, 2.0E6, 2.05E6, 0.72E6, 1.8E6, 2.56E6, 1.69E6, 1.8E6 +CAPB: 1.54E6,1.54E6,1.54E6, 1.54E6, 1.54E6, 1.54E6, 1.54E6, 1.54E6, 1.54E6, 1.54E6, 1.54E6 # # CAPG: Heat capacity of ground (road) [ J m{-3} K{-1} ] # (sf_urban_physics=1,2,3) # -CAPG: 1.75E6, 1.68E6, 1.63E6, 1.54E6, 1.50E6, 1.47E6, 1.67E6, 1.38E6, 1.37E6, 1.49E6, 1.38E6 +CAPG: 1.74E6,1.74E6,1.74E6, 1.74E6, 1.74E6, 1.74E6, 1.74E6, 1.74E6, 1.74E6, 1.74E6, 1.74E6 # # AKSR: Thermal conductivity of roof [ J m{-1} s{-1} K{-1} ] # (sf_urban_physics=1,2,3) # -AKSR: 1.25, 1.25, 1.00, 1.25, 1.25, 1.00, 2.0, 1.25, 1.00, 2.00, 1.25 +AKSR: 1.54,1.54,1.54, 1.54, 1.54, 1.54, 1.54, 1.54, 1.54, 1.54, 1.54 # # AKSB: Thermal conductivity of building wall [ J m{-1} s{-1} K{-1} ] # (sf_urban_physics=1,2,3) # -AKSB: 1.09, 1.5, 1.25, 1.45, 1.45, 1.25, 0.5, 1.25, 1.00, 1.33, 1.25 +AKSB: 1.51,1.51,1.51, 1.51, 1.51, 1.51,1.51,1.51,1.51, 1.51, 1.51 # # AKSG: Thermal conductivity of ground (road) [ J m{-1} s{-1} K{-1} ] # (sf_urban_physics=1,2,3) # -AKSG: 0.77, 0.73, 0.69, 0.64, 0.62, 0.60, 0.72, 0.51, 0.55, 0.61, 0.51 +AKSG: 0.82, 0.82, 0.82, 0.82, 0.82, 0.82, 0.82, 0.82, 0.82, 0.82, 0.82 # # ALBR: Surface albedo of roof [ fraction ] # (sf_urban_physics=1,2,3) # -ALBR: 0.13, 0.18, 0.15, 0.13, 0.13, 0.13, 0.15, 0.18, 0.13, 0.10, 0.13 +ALBR: 0.30, 0.30 0.30, 0.30, 0.30, 0.30, 0.30, 0.30, 0.30, 0.30, 0.30 + # # ALBB: Surface albedo of building wall [ fraction ] # (sf_urban_physics=1,2,3) # -ALBB: 0.25, 0.20, 0.20, 0.25, 0.25, 0.25, 0.20, 0.25, 0.25, 0.20, 0.20 +ALBB: 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3 # # ALBG: Surface albedo of ground (road) [ fraction ] # (sf_urban_physics=1,2,3) # -ALBG: 0.14, 0.14, 0.14, 0.14, 0.14, 0.14, 0.18, 0.14, 0.14, 0.14, 0.14 +ALBG: 0.08, 0.08, 0.08, 0.08, 0.08, 0.08, 0.08, 0.08, 0.08, 0.08, 0.08 # # EPSR: Surface emissivity of roof [ - ] # (sf_urban_physics=1,2,3) # -EPSR: 0.91, 0.91, 0.91, 0.91, 0.91, 0.91, 0.28, 0.91, 0.91, 0.91, 0.95 +EPSR: 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90 # # EPSB: Surface emissivity of building wall [-] # (sf_urban_physics=1,2,3) # -EPSB: 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.95 +EPSB: 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90 # # EPSG: Surface emissivity of ground (road) [ - ] # (sf_urban_physics=1,2,3) # -EPSG: 0.95, 0.95, 0.95, 0.95, 0.95, 0.95, 0.92, 0.95, 0.95, 0.95, 0.95 +EPSG: 0.95, 0.95, 0.95, 0.95, 0.95, 0.95, 0.95, 0.95, 0.95, 0.95, 0.95 # # Z0B: Roughness length for momentum, over building wall [ m ] @@ -348,14 +350,14 @@ Z0R: 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01 # (sf_urban_physics=1,2,3) # -TRLEND: 299.00, 299.00, 299.00, 299.00, 299.00, 299.00, 299.00, 299.00, 299.00, 299.00, 299.00 +TRLEND: 293.00, 293.00, 293.00, 293.00, 293.00, 293.00, 293.00, 293.00, 293.00, 293.00, 293.00 # # TBLEND: Lower boundary temperature for building wall temperature [ K ] # (sf_urban_physics=1,2,3) # -TBLEND: 299.00, 299.00, 299.00, 299.00, 299.00, 299.00, 299.00, 299.00, 299.00, 299.00, 299.00 +TBLEND: 293.00, 293.00, 293.00, 293.00, 293.00, 293.00, 293.00, 293.00, 293.00, 293.00, 293.00 # # TGLEND: Lower boundary temperature for ground (road) temperature [ K ] @@ -368,7 +370,7 @@ TGLEND: 293.00, 293.00, 293.00, 293.00, 293.00, 293.00, 293.00, 293.00, 293.00, # (sf_urban_physics=3) # -COP: 3.5, 3.5, 3.5, 3.5, 3.5, 3.5, 3.5, 3.5, 3.5, 3.5, 3.5 +COP: 4., 4., 4., 4., 4., 4., 4., 4., 4., 4., 4. # # BLDAC_FRC: fraction of buildings installed with A/C systems [ - ] # (sf_urban_physics=3) @@ -388,7 +390,7 @@ COOLED_FRC: 1.0, 1.0, 1.0,1.0, 1.0, 1.0,1.0, 1.0, 1.0,1.0, 1.0 # (sf_urban_physics=3) # -PWIN: 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.9, 0.2, 0.2, 0.2, 0.0 +PWIN: 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.0 # # BETA: Thermal efficiency of heat exchanger @@ -450,7 +452,7 @@ GAPHUM: 0.005, 0.005, 0.005, 0.005, 0.005, 0.005, 0.005, 0.005, 0.005, 0.005, 0. # (sf_urban_physics=3) # -PERFLO: 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.00 +PERFLO: 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.00 # @@ -465,7 +467,7 @@ HSEQUIP: 0.25 0.25 0.25 0.25 0.25 0.25 0.25 0.5 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 # (sf_urban_physics=3) # -HSEQUIP_SCALE_FACTOR: 36.00, 20.00, 20.00, 36.00, 20.00, 20.00, 20.00, 36.00, 20.00, 20.00, 20.00 +HSEQUIP_SCALE_FACTOR: 20.00, 20.00, 20.00, 20.00, 20.00, 20.00, 20.00, 20.00, 20.00, 20.00, 20.00 # @@ -480,7 +482,7 @@ GR_FLAG:0 # (sf_urban_physics=3) # -GR_TYPE: 2 +GR_TYPE: 1 # # GR_FRAC_ROOF: fraction of green roof over the roof (0:1) @@ -502,8 +504,9 @@ IRHO:0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1 # (sf_urban_physics=3) # -PV_FRAC_ROOF: 0,0,0,0,0,0,0,0,0,0,0 +PV_FRAC_ROOF: 0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0. +# STREET PARAMETERS: @@ -513,26 +516,26 @@ STREET PARAMETERS: # category direction width width # [index] [deg from N] [m] [m] - 1 0.0 15. 12. - 1 90.0 15. 12. - 2 0.0 10. 20. - 2 90.0 10. 20. - 3 0.0 5.7 9. - 3 90.0 5.7 9. - 4 0.0 30.0 20. - 4 90.0 30.0 20. - 5 0.0 20.0 20. - 5 90.0 20.0 20. - 6 0.0 12.4 10.5 - 6 90.0 12.4 10.5 - 7 0.0 10. 20. - 7 90.0 10. 20. - 8 0.0 32.5 28.8 - 8 90.0 32.5 28.8 - 9 0.0 10. 10. - 9 90.0 10. 10. - 10 0.0 28.5 23.8 - 10 90.0 28.5 23.8 + 1 0.0 20. 22.22 + 1 90.0 20. 22.22 + 2 0.0 14. 22. + 2 90.0 14. 22. + 3 0.0 5.2 9.6 + 3 90.0 5.2 9.6 + 4 0.0 50.0 42.86 + 4 90.0 50.0 42.86 + 5 0.0 35.0 26.25 + 5 90.0 35.0 26.25 + 6 0.0 13.0 13. + 6 90.0 13.0 13. + 7 0.0 3.33 25. + 7 90.0 3.33 25. + 8 0.0 32.5 28.9 + 8 90.0 32.5 28.9 + 9 0.0 43.3 43.33 + 9 90.0 43.3 43.33 + 10 0.0 28.6 23.8 + 10 90.0 28.6 23.8 11 0.0 100. 5. 11 90.0 100. 5. @@ -639,7 +642,6 @@ BUILDING HEIGHTS: 11 # height Percentage # [m] [%] - 5.0 100.0 + 5.0 100.0 END BUILDING HEIGHTS - From 9f8ecd7964a0ef77ab1861309c6d7c79ec6df249 Mon Sep 17 00:00:00 2001 From: Ted Mansell <37668594+MicroTed@users.noreply.github.com> Date: Tue, 23 Jan 2024 12:36:49 -0600 Subject: [PATCH 36/41] Make sure that USENETCDFPAR is not undefined (#1988) TYPE: bug fix KEYWORDS: make SOURCE: Ted Mansell (NOAA/NSSL) DESCRIPTION OF CHANGES: Problem: Logic failure in top level Makefile with some versions of make (don't remember which) if USENETCDFPAR is undefined Solution: Making sure that at USENETCDFPAR is set to either 0 or 1 in the configure script fixes the issue. LIST OF MODIFIED FILES: configure TESTS: it passed regression tests. --- configure | 2 ++ 1 file changed, 2 insertions(+) diff --git a/configure b/configure index 41243e2813..e17dcb1878 100755 --- a/configure +++ b/configure @@ -219,6 +219,8 @@ if [ -n "$NETCDFPAR" ] ; then export NETCDF export NETCDF4 export USENETCDFPAR +else + export USENETCDFPAR=0 fi if test -z "$NETCDF" ; then From 554b12c81b081e068e24a0111ee360b528bb97b0 Mon Sep 17 00:00:00 2001 From: Cenlin_He Date: Wed, 24 Jan 2024 11:14:12 -0700 Subject: [PATCH 37/41] Update WRF develop with bug fix for LAI initialization for urban pxiel in Noah-MP (#1990) TYPE: bug fix KEYWORDS: LAI, urban, Noah-MP SOURCE: Cenlin He (NCAR/RAL) DESCRIPTION OF CHANGES: Problem: Before bug fix, Noah-MP (v4.5 and earlier versions) initializes leaf mass from the table parameter based on land type. However, this causes model crash if the LCZ capability is activated for urban pixel, because the LCZ land type index (51-61) is out of the MODIS or USGS land type number. This code is in module_sf_noahmpdrv.F file. Solution: Add an if-statement to assign default natural vegetation type for urban pixels with large land type index to represent rural portion of the urban pixel. This is related to a reported Noah-MP issue (NCAR/noahmp#104). LIST OF MODIFIED FILES: phys/noahmp/drivers/wrf/module_sf_noahmpdrv.F TESTS CONDUCTED: - The mods fix the problem - It passed the regression tests. RELEASE NOTE: This PR fixed a bug in Noah-MP for uninitialized leaf area index when LCZ is used. --- phys/noahmp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/phys/noahmp b/phys/noahmp index 4ecebec707..6f2bf7c575 160000 --- a/phys/noahmp +++ b/phys/noahmp @@ -1 +1 @@ -Subproject commit 4ecebec7072e507ed7607012e5a89379348391bf +Subproject commit 6f2bf7c575a0099d60b51efe8811c6519d531abe From c50bf2aa962f8df4b96e54c7449d6c543a06bb7d Mon Sep 17 00:00:00 2001 From: YulongMa Date: Thu, 25 Jan 2024 02:31:05 +0800 Subject: [PATCH 38/41] Add three new wind farm parameterizations and their ensembles (#1944) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit TYPE: new feature KEYWORDS: wind farm parameterization, windfarm wake option SOURCE: Cristina Archer (UDEL), Yulong Ma(UDEL;GWA-MWF) and Ahmad Vasel-Be-Hagh(Tennessee Technological University) DESCRIPTION OF CHANGES: Three new wind farm parameterizations and their ensembles have been added. The key innovation of these parameterizations is their ability to directly account for the individual and overlapping sub-grid wakes of wind turbines within a wind farm. This feature was absent in the Fitch parameterization previously used in WRF. Additionally, the three parameterizations differ in their representation of wakes (e.g., top-hat or Gaussian) and their superposition methods (e.g., sum of squared deficits, squared velocities, or empirical fittings). The new namelist option windfarm_wake_model can be used to select one of the three wind farm parameterizations, the windfarm_overlap_method namelist option can be used to select the desired wake superposition method. We recommend to use the new wind farm parameterizations, particularly for coarse resolution, high turbine density, and wind directions aligned with the turbine columns. LIST OF MODIFIED FILES: dyn_em/module_first_rk_step_part1.F phys/module_pbl_driver.F phys/module_physics_init.F phys/module_wind_jensen.F phys/Makefile Registry/Registry.EM_COMMON run/README.namelist TESTS CONDUCTED: 1. Code tested as shown in references. 2. The Jenkins tests are all passing. RELEASE NOTE: This PR adds options for three new wind farm parameterizations and their ensembles to account for the individual and overlapping sub-grid wakes of wind turbines within a wind farm. It is recommended to use the new wind farm parameterizations, particularly for coarse resolution, high turbine density, and wind directions aligned with the turbine columns. References: Ma, Yulong, Cristina L. Archer, and Ahmadreza Vasel-Be-Hagh. "The Jensen wind farm parameterization." Wind Energy Science 7.6 (2022): 2407-2431. Ma, Yulong, Cristina L. Archer, and Ahmad Vasel‐Be‐Hagh. "Comparison of individual versus ensemble wind farm parameterizations inclusive of sub‐grid wakes for the WRF model." Wind Energy 25.9 (2022): 1573-1595. --- Registry/Registry.EM_COMMON | 9 + dyn_em/module_first_rk_step_part1.F | 2 + phys/Makefile | 1 + phys/module_pbl_driver.F | 52 +- phys/module_physics_init.F | 5 + phys/module_wind_mav.F | 2085 +++++++++++++++++++++++++++ run/README.namelist | 18 +- 7 files changed, 2170 insertions(+), 2 deletions(-) create mode 100644 phys/module_wind_mav.F diff --git a/Registry/Registry.EM_COMMON b/Registry/Registry.EM_COMMON index 5f7b2ab833..408ce329fd 100644 --- a/Registry/Registry.EM_COMMON +++ b/Registry/Registry.EM_COMMON @@ -3369,6 +3369,8 @@ package wrfhydro wrf_hydro==1 - state:SOLDRAIN #WRF Windfarm package no_windfarm windfarm_opt==0 - - package fitchscheme windfarm_opt==1 - state:power +# Yulong add for WLM +package mavscheme windfarm_opt==2 - state:power #Ideal Cases package realcase ideal_case==0 - - @@ -3634,3 +3636,10 @@ xpose XPOSE_SPECTRAL_NUDGING dyn_em dif_analysis,dif_xxx,dif_yyy package no_fft_used fft_used==0 - - package any_fft_used fft_used==1 - state:t_xxx,u_xxx,ru_xxx,v_xxx,rv_xxx,w_xxx,ww_xxx,ph_xxx,dum_yyy,fourd_xxx +# Yulong add for wind wake models +# 1 = Jensen; 2 = XA; 3 = GM +rconfig integer windfarm_wake_model namelist,physics max_domains 2 rh "windfarm_wake_model" "" "" +# +# wake overlap method, M1, M2, M3, M4 [1, 2, 3, 4] +rconfig integer windfarm_overlap_method namelist,physics max_domains 4 rh "windfarm_overlap_method" "" "" +rconfig real windfarm_deg namelist,physics max_domains 0 - "windfarm_deg" "for windfarm ideal case" "degree" diff --git a/dyn_em/module_first_rk_step_part1.F b/dyn_em/module_first_rk_step_part1.F index 10d73577e0..97ec4d86c9 100644 --- a/dyn_em/module_first_rk_step_part1.F +++ b/dyn_em/module_first_rk_step_part1.F @@ -1109,6 +1109,8 @@ SUBROUTINE first_rk_step_part1 ( grid , config_flags & & AKHS=grid%akhs ,AKMS=grid%akms & & ,BL_PBL_PHYSICS=config_flags%bl_pbl_physics & & ,WINDFARM_OPT=config_flags%windfarm_opt,power=grid%power & + & ,windfarm_wake_model=config_flags%windfarm_wake_model & ! Yulong add for WLM + & ,windfarm_overlap_method=config_flags%windfarm_overlap_method & ! Yulong add for WLM & ,BLDT=grid%bldt, CURR_SECS=curr_secs, ADAPT_STEP_FLAG=adapt_step_flag & & ,BLDTACTTIME=grid%bldtacttime & & ,BR=grid%br ,CHKLOWQ=chklowq ,CT=grid%ct & diff --git a/phys/Makefile b/phys/Makefile index c57fcf0e58..dd88587d3c 100644 --- a/phys/Makefile +++ b/phys/Makefile @@ -204,6 +204,7 @@ MODULES = \ module_fddaobs_rtfdda.o \ module_fddaobs_driver.o \ module_wind_fitch.o \ + module_wind_mav.o \ module_sf_lake.o \ module_diagnostics_driver.o \ module_irrigation.o diff --git a/phys/module_pbl_driver.F b/phys/module_pbl_driver.F index bdcf4660b4..3045adfe02 100644 --- a/phys/module_pbl_driver.F +++ b/phys/module_pbl_driver.F @@ -28,6 +28,7 @@ SUBROUTINE pbl_driver( & ,kpbl,mixht,ct,lh,snow,xice & ,znu, znw, mut, p_top & ,ctopo,ctopo2,windfarm_opt,power & + ,windfarm_wake_model, windfarm_overlap_method & ,ysu_topdown_pblmix & ,shinhong_tke_diag & ! OPTIONAL for TEMF scheme @@ -39,7 +40,7 @@ SUBROUTINE pbl_driver( & ,flhc,flqc & ! MYNN ,qke,Sh3d,Sm3d & - ,qke_adv,bl_mynn_tkeadvect & !ACF for QKE advection + ,qke_adv,bl_mynn_tkeadvect & ,tsq,qsq,cov,rmol,ch,qcg,grav_settling & ,dqke,qWT,qSHEAR,qBUOY,qDISS,tke_budget & ,bl_mynn_closure,bl_mynn_cloudpdf & @@ -155,6 +156,7 @@ SUBROUTINE pbl_driver( & CAMUWPBLSCHEME,BEPSCHEME,BEP_BEMSCHEME,MYJSFCSCHEME, & FITCHSCHEME,SHINHONGSCHEME, & TEMFPBLSCHEME,GBMPBLSCHEME,EEPSSCHEME,KEPSSCHEME, & + MAVSCHEME, & ! Yulong add for WLM CAMMGMPSCHEME,p_qi,p_qni,p_qnc,param_first_scalar,& !CAMMGMPSCHEME, p_qni,p_qnc is used for camuwpbl scheme p_qnwfa,p_qnifa,p_qnbca #if ( WRFPLUS == 1 ) @@ -167,6 +169,7 @@ SUBROUTINE pbl_driver( & , TEMFPBLSCHEME, GFSEDMFSCHEME & , CAMUWPBLSCHEME & , FITCHSCHEME, SHINHONGSCHEME & + , MAVSCHEME ! Yulong add for WLM , GBMPBLSCHEME, MYJSFCSCHEME #endif @@ -198,6 +201,7 @@ SUBROUTINE pbl_driver( & USE module_bl_keps USE module_bl_fogdes USE module_wind_fitch + USE module_wind_mav ! Yulong add for WLM #endif ! This driver calls subroutines for the PBL parameterizations. @@ -434,6 +438,9 @@ SUBROUTINE pbl_driver( & REAL, DIMENSION( ims:ime, jms:jme ), & INTENT(IN), OPTIONAL :: xlat_u,xlong_u,xlat_v,xlong_v + ! Yulong add for WLM + INTEGER, INTENT(IN ) :: windfarm_wake_model, windfarm_overlap_method + REAL, DIMENSION( ims:ime, kms:kme ,jms:jme ), & INTENT(IN), OPTIONAL :: w ! @@ -820,6 +827,8 @@ SUBROUTINE pbl_driver( & integer iu_bep,iurb,idiff real seamask,thsk,zzz,unew,vnew,tnew,qnew,umom,vmom REAL :: z0,z1,z2,w1,w2 + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) :: TKE_windfarm ! Yulong add for WLM ! ! FASDAS ! @@ -2062,6 +2071,47 @@ SUBROUTINE pbl_driver( & CALL wrf_error_fatal('Lack arguments to call turbine_drag') ENDIF + ! Yulong add new wind farm schemes with wind turbine loss effect + CASE (mavscheme) + IF (PRESENT(id) .AND. & + PRESENT(z_at_w) ) THEN + CALL wrf_debug(100,'in phys/module_wind_mav.F') + CALL dragforce_mav(itimestep & + &,ID=id & + &,Z_AT_W=z_at_w,z_at_m=z,u=u_phy,v=v_phy & + &,DX=dx,DZ=dz8w,DT=dt & + &,TKE=TKE_windfarm & + &,DU=rublten,DV=rvblten & + &,WINDFARM_OPT=windfarm_opt,POWER=power & + &,windfarm_wake_model=windfarm_wake_model & + &,windfarm_overlap_method=windfarm_overlap_method & + &,xland=xland & + &,cosa=cosa,sina=sina & + &,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde & + &,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme & + &,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte & + &) + + IF (bl_mynn_tkeadvect) THEN + QKE = QKE + 2.*TKE_windfarm + qke_adv=qke + ENDIF + + ELSE + WRITE ( message , FMT = '(A,6(L1,1X))' ) & + 'present: '// & + 'ID, '// & + 'z_at_w, '// & + 'xlat_u, '// & + 'xlong_u, '// & + 'xlat_v, '// & + 'xlong_v = ' , & + PRESENT( id ) , & + PRESENT( z_at_w ) + CALL wrf_debug(0,message) + CALL wrf_error_fatal('Lack arguments to call dragforce_mav') + ENDIF + END SELECT windfarm_select #endif diff --git a/phys/module_physics_init.F b/phys/module_physics_init.F index 42dd4f0609..0a8595b1e5 100644 --- a/phys/module_physics_init.F +++ b/phys/module_physics_init.F @@ -284,6 +284,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf, & USE module_cam_support, ONLY : cam_mam_aerosols #endif USE module_wind_fitch + USE module_wind_mav ! Yulong add for WLM IMPLICIT NONE !----------------------------------------------------------------- TYPE (grid_config_rec_type) :: config_flags @@ -1394,6 +1395,10 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf, & ! IF ( config_flags%windfarm_opt .EQ. 1 ) THEN CALL init_module_wind_fitch(id,config_flags,xlong,xlat,windfarm_initialized,ims,ime,jms,jme,its,ite,jts,jte,ids,ide,jds,jde) + ! --- Yulong --- + ELSEIF ( config_flags%windfarm_opt .EQ. 2 ) THEN + CALL init_module_wind_mav(id,config_flags,xlong,xlat,windfarm_initialized, & + dx,ims,ime,jms,jme,its,ite,jts,jte,ids,ide,jds,jde) ENDIF CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to ra_init' ) diff --git a/phys/module_wind_mav.F b/phys/module_wind_mav.F new file mode 100644 index 0000000000..dabb6f1e36 --- /dev/null +++ b/phys/module_wind_mav.F @@ -0,0 +1,2085 @@ +!WRF:MODEL_LAYER:PHYSICS + +MODULE module_wind_mav +! +! Represents kinetic energy extracted by wind turbines and turbulence +! (TKE) they produce at model levels within the rotor area. +! This module is based on module_wind_fitch but uses the Jensen, XA and Gm wake +! loss models instead of the Fitch parameterization + +! Code by Yulong MA (Guangdong-Hong kong-Macau Greater Bay Area Weather +! Research Center for Monitoring Warning and Forecasting;UDEL) and Cristina L. Archer (UDEL) + +! --- NOTICE --- +! The following papers should be cited whenever presenting results using this scheme: +! Ma, Yulong, Cristina L. Archer, and Ahmadreza Vasel-Be-Hagh. "The Jensen wind +! farm parameterization." Wind Energy Science 7.6 (2022): 2407-2431. +! Ma, Yulong, Cristina L. Archer, and Ahmad Vasel‐Be‐Hagh. "Comparison of +! individual versus ensemble wind farm parameterizations inclusive of sub‐grid +! wakes for the WRF model." Wind Energy 25.9 (2022): 1573-1595. +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! + +#if defined(mpas) + use mpas_dmpar + use mpas_derived_types + + IMPLICIT NONE + INTEGER, PARAMETER :: max_domains = 1 + REAL, PARAMETER :: piconst = 3.141593 + logical, save :: windfarm_initialized = .false. ! MPAS +#else + + USE module_driver_constants, ONLY : max_domains + USE module_model_constants, ONLY : piconst + + USE module_llxy + USE module_dm, ONLY : wrf_dm_min_real, wrf_dm_sum_reals + USE module_configure, ONLY : grid_config_rec_type + + + IMPLICIT NONE +#endif + + INTEGER, PARAMETER :: MAXVALS = 100 + INTEGER :: nt + INTEGER, DIMENSION(:), ALLOCATABLE :: NKIND, NVAL + INTEGER, DIMENSION(:,:), ALLOCATABLE :: ival,jval ! grid number in WRF + REAL, DIMENSION(:), ALLOCATABLE :: hubheight, radius, radius2, diameter, area,& + stc, stc2, cutin, cutout, npower + REAL, DIMENSION(:,:), ALLOCATABLE :: xturb, yturb ! (nt, maxdomain) + REAL, DIMENSION(:,:), ALLOCATABLE :: turbws, turbtc, turbpw, turbpwcof ! (nt,maxvals) + + REAL :: correction_factor + + CONTAINS + + !====================================================================== + + subroutine dragforce_mav(itimestep & + &,id & + &,z_at_w,z_at_m,u,v & + &,dx,dz,dt,tke & + &,du,dv & + &,windfarm_opt,power & + &,windfarm_wake_model, windfarm_overlap_method & + &,xland & +#if defined(mpas) + &,dminfo & + &,windfarm_ij, windfarm_deg & + &,xcell, ycell & +#else + &,cosa,sina & +#endif + &,ids,ide,jds,jde,kds,kde & + &,ims,ime,jms,jme,kms,kme & + &,its,ite,jts,jte,kts,kte & + &) + + implicit none + + integer, intent(in) :: id,windfarm_opt, windfarm_wake_model, windfarm_overlap_method + integer, intent(in) :: its,ite,jts,jte,kts,kte + integer, intent(in) :: ims,ime,jms,jme,kms,kme + integer, intent(in) :: ids,ide,jds,jde,kds,kde + real, intent(in) :: dx, dt + real, dimension(ims:ime,kms:kme,jms:jme), intent(in) :: dz, u, v, z_at_w, z_at_m + real, dimension(ims:ime,kms:kme,jms:jme), intent(inout) :: du, dv, tke + real, dimension(ims:ime,jms:jme), intent(in) :: xland + real, dimension(ims:ime,jms:jme), intent(inout) :: power + integer, intent(in) :: itimestep + + real, dimension(ims:ime,kms:kme,jms:jme) :: Uearth, Vearth ! earth-relative u and v + +#if defined(mpas) + type(dm_info),intent(in) :: dminfo + integer, intent(in) :: windfarm_ij + real, intent(in) :: windfarm_deg + real, dimension(ims:ime, jms:jme), intent(in) :: xcell, ycell !hexgon cell center +#else + real, dimension(ims:ime,jms:jme), intent(in) :: cosa,sina +#endif + + ! Local + real :: wfdensity + integer :: itf, jtf, i, j, k + integer :: wake_model, num_models, overlap_method + integer :: wake_model_en(5), overlap_method_en(5) + real, dimension(kms:kme) :: z_tmp + real, dimension(ims:ime,kms:kme,jms:jme) :: tke_wk, du_wk, dv_wk + + real :: kw_nt(nt) + real :: search_angle, search_dis + integer :: ii, tt, kt + integer :: num_ups_pot(nt), ups_indx_pot(nt,nt) ! potential ups turbines + real :: avg_angle_tb(nt,nt) ! potential ups turbines + + integer :: tbindx(nt), num_ups(nt), ups_index(nt,nt) + real :: ao_ups(nt,nt), ax_dist(nt,nt), ay_dist(nt,nt), az_dist(nt,nt) + real :: blockfrac(nt), blockdist(nt), rblockdist(nt), ytb_rot_gm(nt,nt) ! GM + logical :: find_tb + real :: u_hub_nt(nt), v_hub_nt(nt), Uinf(nt), ulocal(nt), xland_nt(nt), terrain_nt(nt) + real :: power_nt(nt), power_nt_md(5,nt) + + ! dir avg + integer, parameter :: dir_num = 7 + real, parameter :: dir_avg_window = 5.0 ! +- 2.5 unit [degree] + integer :: dir_ii + real :: dtheta + real :: dtheta_list(7) ! [-2.5, -1.5, -0.5, 0., 0.5, 1.5, 2.5] + real :: dtheta_avg_cof(7) !gaussian distribution + real :: dtheta_std !gaussian distribution std + + ! parallel computing + real :: dm_local_u_hub_nt(nt), dm_global_u_hub_nt(nt) + real :: dm_local_v_hub_nt(nt), dm_global_v_hub_nt(nt) + real :: dm_local_xland_nt(nt), dm_global_xland_nt(nt) + real :: dm_local_terrain_nt(nt), dm_global_terrain_nt(nt) + integer :: ic_tb + + integer,save :: n_valid_cur = 0 + integer :: tb_valid_cur(nt) + + +#if defined(mpas) + wfdensity = 1.0/(dx*dx*sqrt(3.)/2.) +#else + wfdensity = 1.0/(dx*dx) +#endif + + tb_valid_cur(:) = 1 ! set all tbs in operation + + !--------------------------------------------- + ! Gaussion distribution direction avg + dtheta_list(1) = -2.5; dtheta_list(7) = 2.5; + dtheta_list(2) = -1.5; dtheta_list(6) = 1.5; + dtheta_list(3) = -0.5; dtheta_list(5) = 0.5; + dtheta_list(4) = 0. + + dtheta_std = 2.0 ! std [deg] + dtheta_avg_cof(1) = exp(-dtheta_list(1)**2/(2.*dtheta_std**2)) + dtheta_avg_cof(2) = exp(-dtheta_list(2)**2/(2.*dtheta_std**2)) + dtheta_avg_cof(3) = exp(-dtheta_list(3)**2/(2.*dtheta_std**2)) + dtheta_avg_cof(4) = 1. + dtheta_avg_cof(7) = dtheta_avg_cof(1) + dtheta_avg_cof(6) = dtheta_avg_cof(2) + dtheta_avg_cof(5) = dtheta_avg_cof(3) + + dtheta_avg_cof(:) = dtheta_avg_cof(:)/sum(dtheta_avg_cof) + !--------------------------------------------- + + ! + ! for parallel computing + ! + itf = MIN0(ite,ide-1) + jtf = MIN0(jte,jde-1) + + dm_local_u_hub_nt(:) = 0. + dm_local_v_hub_nt(:) = 0. + dm_local_xland_nt(:) = 0. + dm_local_terrain_nt(:) = 0. + dm_global_u_hub_nt(:) = 0. + dm_global_v_hub_nt(:) = 0. + dm_global_xland_nt(:) = 0. + dm_global_terrain_nt(:) = 0. + ic_tb = 0 + +#if defined(mpas) + do kt = 1, nt + i = ival(kt,id) + j = jval(kt,id) + if (i >= its .and. i <= itf .and. j >= jts .and. j <= jtf) then + ic_tb = ic_tb + 1 + z_tmp = z_at_m(i,:,j) - z_at_w(i,1,j) ! mass point height + call to_zk2(hubheight(kt), z_tmp(1:kme-1), u(i,1:kme-1,j), kme-1, dm_local_u_hub_nt(kt)) + call to_zk2(hubheight(kt), z_tmp(1:kme-1), v(i,1:kme-1,j), kme-1, dm_local_v_hub_nt(kt)) + end if + end do + call mpas_dmpar_sum_real_array(dminfo, nt, dm_local_u_hub_nt, dm_global_u_hub_nt) + call mpas_dmpar_sum_real_array(dminfo, nt, dm_local_v_hub_nt, dm_global_v_hub_nt) + +#else + + + ! ---- WRF grid related wind direction to earth related direction --- + ! for Non Mercator projection, the wind direction should be rotated to earth + ! coordinates (where U would be west-east and V would be north-south) + ! https://www2.mmm.ucar.edu/wrf/users/FAQ_files/Miscellaneous.html + DO j = jts, min(jte,jde-1) + DO k = kts, kte-1 + DO i = its, min(ite,ide-1) + Uearth(i,k,j) = U(i,k,j)*cosa(i,j) - V(i,k,j)*sina(i,j) + Vearth(i,k,j) = V(i,k,j)*cosa(i,j) + U(i,k,j)*sina(i,j) + ENDDO + ENDDO + ENDDO + + do kt = 1, nt + i = ival(kt,id) + j = jval(kt,id) + if (i >= its .and. i <= itf .and. j >= jts .and. j <= jtf) then + ic_tb = ic_tb + 1 + z_tmp = z_at_m(i,:,j) - z_at_w(i,1,j) ! mass point height + call to_zk2(hubheight(kt), z_tmp(1:kme-1), Uearth(i,1:kme-1,j), kme-1, dm_local_u_hub_nt(kt)) + call to_zk2(hubheight(kt), z_tmp(1:kme-1), Vearth(i,1:kme-1,j), kme-1, dm_local_v_hub_nt(kt)) + + dm_local_xland_nt(kt) = xland(i,j) + dm_local_terrain_nt(kt) = z_at_w(i,1,j) + end if + + ! if turbine kt is out of the whole domain (i or j == -9999), assume it is not at + ! upstream of any turbines (distance >= 20D), set xturb, yturb to a large value + ! and set uhub, vhub to a small value. It should have no effects on the rest of turbines. + if (i == -9999 .or. j == -9999) then + tb_valid_cur(kt) = 0 + dm_local_u_hub_nt(kt) = 1.e-3 + dm_local_v_hub_nt(kt) = 1.e-3 + endif + end do + + call wrf_dm_sum_reals(dm_local_u_hub_nt, dm_global_u_hub_nt) + call wrf_dm_sum_reals(dm_local_v_hub_nt, dm_global_v_hub_nt) + call wrf_dm_sum_reals(dm_local_xland_nt, dm_global_xland_nt) + call wrf_dm_sum_reals(dm_local_terrain_nt, dm_global_terrain_nt) +#endif + + u_hub_nt(:) = dm_global_u_hub_nt(:) + v_hub_nt(:) = dm_global_v_hub_nt(:) + xland_nt(:) = dm_global_xland_nt(:) + terrain_nt(:) = dm_global_terrain_nt(:) + + !if (ic_tb == 0) return ! no turbine in this tile, no need to do the rest part + + + ! + ! potential ups turbines in a fan-shaped region + ! + Uinf(:) = sqrt(u_hub_nt(:)**2 + v_hub_nt(:)**2) ! hub height speed + + search_angle = 30.*piconst/180. ! +-30 deg, a wider region because of wind dir avg + search_dis = 20.*diameter(1) ! 20D + num_ups_pot(:) = 0 + do kt = 1, nt + if (tb_valid_cur(kt) == 0) cycle ! turbine is turned off or outside of the domain + ii = 0 + do tt = 1, nt + if (tt == kt) cycle + find_tb = find_turb(xturb(kt,id), yturb(kt,id), xturb(tt,id), yturb(tt,id), & + u_hub_nt(kt), v_hub_nt(kt), search_angle, search_dis) + if (find_tb) then + ii = ii + 1 + ups_indx_pot(kt, ii) = tt + avg_angle_tb(kt, tt) = atan2(v_hub_nt(kt)+v_hub_nt(tt), u_hub_nt(kt)+u_hub_nt(tt)) + end if + end do + num_ups_pot(kt) = ii + end do + + + ! + ! dir avg start + ! + tke_wk(:,:,:) = 0. + du_wk(:,:,:) = 0. + dv_wk(:,:,:) = 0. + power(:,:) = 0. + power_nt(:) = 0. ! output to a txt file + power_nt_md(:,:) = 0. ! output to a txt file + + !------------------- Ensemble --------------------- + if (windfarm_wake_model <= 3) then + num_models = 1 + wake_model_en(1) = windfarm_wake_model + overlap_method_en(1) = windfarm_overlap_method + + ! 1=JS, 2=XA, 3=GM + else if (windfarm_wake_model == 4) then ! JS-M4 + XA-M3 + num_models = 2 + wake_model_en(1) = 1; overlap_method_en(1) = 4 + wake_model_en(2) = 2; overlap_method_en(2) = 3 + + else if (windfarm_wake_model == 5) then ! JS-M4 + XA-M3 + GM + num_models = 3 + wake_model_en(1) = 1; overlap_method_en(1) = 4 + wake_model_en(2) = 2; overlap_method_en(2) = 3 + wake_model_en(3) = 3; overlap_method_en(3) = 2 + + else if (windfarm_wake_model == 6) then ! JS-M3 + JS-M4 + XA-M3 + GM, single-cell + num_models = 4 + wake_model_en(1) = 1; overlap_method_en(1) = 3 + wake_model_en(2) = 1; overlap_method_en(2) = 4 + wake_model_en(3) = 2; overlap_method_en(3) = 3 + wake_model_en(4) = 3; overlap_method_en(4) = 2 + + else if (windfarm_wake_model == 7) then ! JS-M4 + XA-M3 + XA-M4 + GM, multi-cell + num_models = 4 + wake_model_en(1) = 1; overlap_method_en(1) = 4 + wake_model_en(2) = 2; overlap_method_en(2) = 3 + wake_model_en(3) = 2; overlap_method_en(3) = 4 + wake_model_en(4) = 3; overlap_method_en(4) = 2 + end if + !------------------- Ensemble --------------------- + + do dir_ii = 1, dir_num ! dir avg loop + if (dir_num > 1) then + !dtheta = -(0.5*dir_avg_window - (dir_ii-1.)/(dir_num-1.)*dir_avg_window)/180.*piconst + dtheta = dtheta_list(dir_ii)/180.*piconst + else + dtheta = 0. + end if + + do ii = 1, num_models + wake_model = wake_model_en(ii) + overlap_method = overlap_method_en(ii) + + ! actual upstream turbines (overlap area > 0) + call ups_turbs(kw_nt, ao_ups, ax_dist, ay_dist, az_dist, ytb_rot_gm, ups_index, num_ups, & + num_ups_pot, ups_indx_pot, avg_angle_tb, xturb(:,id), yturb(:,id), & + radius, area, hubheight, xland_nt, terrain_nt, nt, dtheta, wake_model) + + ! sort all turbines from the most upstream turbine + ! NOT BASED on ax_dist because they are not at the same diretion. + ! (a directed graph problem) + call sort_turb(nt, num_ups, ups_index, tbindx) + + ! cal. def and local speed + if (wake_model == 1) then + call cal_tb_ulocal_JS(ulocal, uinf, tbindx, num_ups, ups_index, & + ax_dist, Ao_ups, kw_nt, nt, radius, tb_valid_cur, overlap_method) + + else if (wake_model == 2) then + call cal_tb_ulocal_XA(ulocal, uinf, tbindx, num_ups, ups_index, & + ax_dist, ay_dist, az_dist, Ao_ups, & + nt, radius, radius2, tb_valid_cur, overlap_method) + + else if (wake_model == 3) then + call cal_tb_ulocal_GM(ulocal, blockfrac, blockdist, rblockdist, & + uinf, tbindx, num_ups, ups_index, & + ax_dist, ay_dist, az_dist, ytb_rot_gm, & + nt, radius, tb_valid_cur) + end if + + ! cal power and WRF tendencies + call cal_power_wrf_tend(ulocal, uinf, tb_valid_cur, blockfrac, blockdist, u, v, dz, z_at_w, & + ival(:,id), jval(:,id), nt, radius, diameter, hubheight, area, & + wake_model, wfdensity, dt, & + power_nt_md(ii,:), power, tke_wk, du_wk, dv_wk, dtheta_avg_cof(dir_ii), & + ims,ime,jms,jme,kms,kme,its,itf,jts,jtf) + end do + end do + + tke_wk = tke_wk/num_models + du_wk = du_wk/num_models + dv_wk = dv_wk/num_models + power = power/num_models + + tke = tke_wk ! turbine generated TKE + du = du + du_wk + dv = dv + dv_wk + + do ii = 1, num_models + power_nt(:) = power_nt(:) + power_nt_md(ii,:) + enddo + power_nt = power_nt/num_models + + ! write fraction power of each turbine to a txt at 4 hr + !call write_power_txt(windfarm_wake_model, windfarm_overlap_method, itimestep, dt, its, jts, & + ! dx, power_nt, power_nt_md, ulocal, nt, num_models) + + end subroutine dragforce_mav + + +!============================================================================== +!============================================================================== + + + subroutine write_power_txt(windfarm_model, windfarm_method, itimestep, dt, its, jts, & + dx, power_nt, power_nt_md, ulocal, nt, num_models) + ! this function might be improved later. + implicit none + integer :: nt, windfarm_model, windfarm_method, itimestep, its, jts, num_models + real :: dx, power_nt(nt), ulocal(nt), power_nt_md(5,nt), dt + integer :: it_out, ii, i, j, kt + integer,save :: it_init = 0, write_out = 0 + character(len=1024) :: fmt_my, str_my, fn_my + real :: out_hr, max_power + + out_hr = 4. ! hr + + if (it_init == 0) it_init = itimestep + + write (str_my, "(I1)") windfarm_method + + IF (windfarm_model == 1) THEN + fn_my = 'power_nt_JS_M'//trim(str_my)//'.txt_5.0d_0.25' + ELSEIF (windfarm_model == 2) THEN + fn_my = 'power_nt_XA_M'//trim(str_my)//'.txt_5.0d_0.25' + ELSEIF (windfarm_model == 3) THEN + IF (windfarm_method == 2) fn_my = 'power_nt_GM_MC.txt_5.0d_0.25' + IF (windfarm_method == 3) fn_my = 'power_nt_GM_AN.txt_5.0d' + ENDIF + + IF (windfarm_model == 4) fn_my = 'power_nt_EN2.txt_5.0d_0.25' + IF (windfarm_model == 5) fn_my = 'power_nt_EN3.txt_5.0d_0.25' + + IF (windfarm_model == 6) fn_my = 'power_nt_EN6.txt_2.5d' + IF (windfarm_model == 7) fn_my = 'power_nt_EN7.txt_2.5d' + + + !if (itimestep == it_out .and. its == 1 .and. jts == 1) then + if ((itimestep-it_init)*dt >= 4.*3600. .and. write_out == 0 .and. its == 1 .and. jts == 1) then + write_out = 1 + + write(*,*) 'output relative power', (itimestep-it_init)*dt + OPEN ( FILE = fn_my, UNIT = 923) + write (str_my, "(I6)") nt + fmt_my = '('//trim(str_my)//'F12.2)' + + write(923,FMT=fmt_my) power_nt(1:nt) + + do ii = 1, num_models + write(923,FMT=fmt_my) power_nt_md(ii,1:nt) + end do + + write(923,FMT=fmt_my) ulocal(1:nt) + CLOSE(923) + + endif + end subroutine write_power_txt + +!--------------------------------------------------------------- + + subroutine ups_turbs( kw_nt, ao_ups, ax_dist, ay_dist, az_dist, ytb_rot_gm, ups_index, num_ups, & + num_ups_pot, ups_indx_pot, avg_angle_tb, xturb, yturb, & + radius, area, hubheight, xland_nt, terrain_nt, nt, dtheta, windfarm_model) + implicit none + integer, intent(in) :: nt, num_ups_pot(nt), ups_indx_pot(nt,nt), windfarm_model + real, intent(in) :: avg_angle_tb(nt,nt), xturb(nt), yturb(nt), & + radius(nt), area(nt), hubheight(nt), xland_nt(nt), terrain_nt(nt) + real, intent(out) :: ao_ups(nt,nt), ax_dist(nt,nt), ay_dist(nt,nt), az_dist(nt,nt), & + ytb_rot_gm(nt,nt), kw_nt(nt) + integer, intent(out) :: ups_index(nt,nt), num_ups(nt) + real :: dtheta + + integer :: num_ups_turb, tt, jt, kt, ii + real :: cur_tb_ang, ax_GM(nt), x_ups_tmp, y_ups_tmp, x_cur, y_cur, & + axialdist, Ao, wakewidth + real :: kw_tmp, kw_test(nt), kw + + !----------------------- + do kt = 1, nt + if (xland_nt(kt) > 1.5) then ! water = 2 + kw = 0.04 ! offshore + else if (xland_nt(kt) < 1.5) then ! land = 1 + kw = 0.0075 ! onshore + end if + + if (windfarm_model == 1) then + kw_test(kt) = kw + kw_nt(kt) = kw + else if (windfarm_model == 2) then + kw_test(kt) = 5.*kw ! choose a larger search region for XA + end if + end do + + if (windfarm_model == 3) then + kw_test(:) = 0. ! no wake expandation for GM + end if + !----------------------- + + + do kt = 1, nt + num_ups_turb = 0 + do tt = 1, num_ups_pot(kt) + + jt = ups_indx_pot(kt,tt) + + cur_tb_ang = avg_angle_tb(kt,jt) + dtheta + call coordinate_rotation(x_cur, y_cur, xturb(kt), yturb(kt), cur_tb_ang) + call coordinate_rotation(x_ups_tmp, y_ups_tmp, xturb(jt), yturb(jt), cur_tb_ang) + + axialdist = x_cur - x_ups_tmp + if (axialdist <= 0.) then + Ao = 0. + else + kw_tmp = kw_test(jt) + wakewidth = radius(jt) + kw_tmp*axialdist + Ao = AreaOverlap(y_cur, y_ups_tmp, hubheight(kt)+terrain_nt(kt), & + hubheight(jt)+terrain_nt(jt), radius(kt), wakewidth) + end if + + !if (Ao/area(kt) > 0.) then + if (Ao/area(kt) > 0.01) then + num_ups_turb = num_ups_turb + 1 + ups_index(kt,num_ups_turb) = jt + Ao_ups(kt,jt) = Ao/area(kt) + ax_dist(kt,jt) = axialdist + ay_dist(kt,jt) = y_cur - y_ups_tmp + az_dist(kt,jt) = (hubheight(kt) + terrain_nt(kt)) - & + (hubheight(jt) + terrain_nt(jt)) + + ax_gm(num_ups_turb) = axialdist ! for GM to sort ups turbines + ytb_rot_gm(kt,jt) = y_ups_tmp + end if + + ! used in analytical GM, it changes if ups turbines are + ! in different grid cells, just approximate value here. TO BE IMPROVED! + ytb_rot_gm(kt,kt) = y_cur + + end do + num_ups(kt) = num_ups_turb + + if (windfarm_model == 3 .and. num_ups(kt) > 1) then ! GM model + call sort_gm(num_ups(kt), ups_index(kt,1:num_ups(kt)), ax_gm(1:num_ups(kt))) + end if + + end do + + end subroutine ups_turbs + +!--------------------------------------------------------------- + + subroutine cal_tb_ulocal_JS(ulocal, uinf, tbindx, num_ups, ups_index, & + ax_dist, Ao_ups, kw_nt, nt, radius, tb_valid_cur, overlap_method) + implicit none + real, intent(out) :: ulocal(nt) + real, intent(in ) :: uinf(nt), Ao_ups(nt,nt), ax_dist(nt,nt), radius(nt), kw_nt(nt) + integer, intent(in) :: nt, tbindx(nt), num_ups(nt), ups_index(nt,nt), overlap_method + integer,intent(in) :: tb_valid_cur(nt) + + ! turbws, turbtc, turbpwcof, stc, stc2, nval are global varibles, not defined here + + integer :: kt, it, jt, tt, nv + real :: Udef_nt(nt), def_ij, tmp, thrcof + + ulocal(:) = uinf(:) + + do kt = 1, nt + + if (tb_valid_cur(kt) == 0) cycle ! turbine is turned off or outside of the domain + + it = tbindx(kt) ! tb of interet + + if (num_ups(it) == 0) cycle + + Udef_nt(:) = 0. + do tt = 1, num_ups(it) + jt = ups_index(it,tt) + nv = nval(jt) + call dragcof(tmp, tmp, thrcof, ulocal(jt), turbws(jt,1:nv), & + turbtc(jt,1:nv), turbpwcof(jt,1:nv), stc(jt), stc2(jt), nv) + + def_ij = (1. - sqrt(1. - thrcof))/(1. + kw_nt(jt)*ax_dist(it,jt)/radius(jt))**2*Ao_ups(it,jt) + + ! wake overlapping methods M1 - M4 + if (overlap_method == 1 .or. overlap_method == 2) then + Udef_nt(jt) = uinf(jt)*def_ij*Ao_ups(it,jt) + + else if (overlap_method == 3) then + Udef_nt(jt) = ulocal(jt)*def_ij*Ao_ups(it,jt) + + ! Here Udef_nt is actually a local U, not a DeltaU + else if (overlap_method == 4) then + Udef_nt(jt) = uinf(it)*(1. - Ao_ups(it,jt)) + uinf(jt)*(1. - def_ij)*Ao_ups(it,jt) + end if + + end do + + if (overlap_method == 1) then + ulocal(it) = Uinf(it) - sum(Udef_nt) + else if (overlap_method == 2 .or. overlap_method == 3) then + ulocal(it) = Uinf(it) - sqrt(sum(Udef_nt**2)) + else if (overlap_method == 4) then + ulocal(it) = sqrt(sum(Udef_nt**2)/num_ups(it)) + end if + + enddo + + end subroutine cal_tb_ulocal_JS + +!--------------------------------------------------------------- + + subroutine cal_tb_ulocal_XA(ulocal, uinf, tbindx, num_ups, ups_index, & + ax_dist, ay_dist, az_dist, Ao_ups, & + nt, radius, radius2, tb_valid_cur, overlap_method) + implicit none + real, intent(out) :: ulocal(nt) + real, intent(in ) :: uinf(nt), Ao_ups(nt,nt), ax_dist(nt,nt), ay_dist(nt,nt), & + az_dist(nt,nt), radius(nt), radius2(nt) + integer, intent(in) :: nt, tbindx(nt), num_ups(nt), ups_index(nt,nt), overlap_method + integer,intent(in) :: tb_valid_cur(nt) + + ! turbws, turbtc, turbpwcof, stc, stc2, nval are global varibles, not defined here + + real :: ky, kz + integer :: kt, it, jt, tt, nv + real :: Udef_nt(nt), def_ij, tmp, thrcof + real :: beta, eps, sigmay, sigmaz, def_avg + + ! --- Are ky and kz the same over land? + ky = 0.025 + kz = 0.0175 + + ulocal(:) = uinf(:) + + do kt = 1, nt + + if (tb_valid_cur(kt) == 0) cycle ! turbine is turned off or outside of the domain + + it = tbindx(kt) ! tb of interet + + if (num_ups(it) == 0) cycle + + Udef_nt(:) = 0. + do tt = 1, num_ups(it) + jt = ups_index(it,tt) + nv = nval(jt) + call dragcof(tmp, tmp, thrcof, ulocal(jt), turbws(jt,1:nv), & + turbtc(jt,1:nv), turbpwcof(jt,1:nv), stc(jt), stc2(jt), nv) + + beta = 0.5*(1. + sqrt(1. - thrcof))/sqrt(1. - thrcof) + eps = 0.25*sqrt(beta) + sigmay = ky*ax_dist(it,jt) + eps*2*radius(jt) + sigmaz = kz*ax_dist(it,jt) + eps*2*radius(jt) + call Gaussian_integral(ay_dist(it,jt), az_dist(it,jt), radius(it), sigmay, sigmaz, def_avg) + def_ij = (1. - sqrt(1.-radius2(jt)*thrcof/sigmay/sigmaz/2.))*def_avg + + ! wake overlapping methods M1 - M4 + if (overlap_method == 1 .or. overlap_method == 2) then + Udef_nt(jt) = Uinf(jt)*def_ij + + else if (overlap_method == 3) then + Udef_nt(jt) = ulocal(jt)*def_ij + + ! Here Udef_nt is actually a local U, not a DeltaU + else if (overlap_method == 4) then + Udef_nt(jt) = Uinf(jt)*(1. - def_ij) + end if + end do + + if (overlap_method == 1) then + ulocal(it) = Uinf(it) - sum(Udef_nt) + else if (overlap_method == 2 .or. overlap_method == 3) then + ulocal(it) = Uinf(it) - sqrt(sum(Udef_nt**2)) + else if (overlap_method == 4) then + ulocal(it) = sqrt(sum(Udef_nt**2)/num_ups(it)) + end if + end do + + end subroutine cal_tb_ulocal_XA + +!--------------------------------------------------------------- + + subroutine cal_tb_ulocal_GM(ulocal, blockfrac, blockdist, rblockdist, & + uinf, tbindx, num_ups, ups_index, & + ax_dist, ay_dist, az_dist, ytb_rot_gm, & + nt, radius, tb_valid_cur) + implicit none + real, intent(out) :: ulocal(nt), blockfrac(nt), blockdist(nt), rblockdist(nt) + integer, intent(in) :: nt, tbindx(nt), num_ups(nt), ups_index(nt,nt) + real, intent(in) :: uinf(nt), ax_dist(nt,nt), ay_dist(nt,nt), az_dist(nt,nt), & + ytb_rot_gm(nt,nt), radius(nt) + integer,intent(in) :: tb_valid_cur(nt) + integer :: kt, it + real :: gfun_GM + + integer, parameter :: ndisk = 50 ! 50x50 samples for montecarlo + real, parameter :: MAXD = 20. ! upsteam within 20d + integer :: ii, jd, kd, jt, tt, nblock + integer :: ndiskpt + real :: diskpt(ndisk) + real :: distblk(ndisk,ndisk), rdistblk(ndisk,ndisk) + real :: scaled_axdist(nt), raxdist(nt) + integer :: on_disk(ndisk,ndisk) + real :: on_disk_1d(ndisk*ndisk) + real :: on_disk_1d_y(ndisk*ndisk), on_disk_1d_z(ndisk*ndisk) + real :: on_disk_1d_yr(ndisk*ndisk), on_disk_1d_zr(ndisk*ndisk) + real :: distblk_1d(ndisk*ndisk), rdistblk_1d(ndisk*ndisk) + + integer, parameter :: cal_method = 2 ! 1 : analytical, 2 = montecarlo + + ulocal(:) = uinf(:) + + if (cal_method == 2) then + + do ii = 1, ndisk + diskpt(ii) = -1. + (ii-0.5)/ndisk*2. + end do + + !on_disk(:,:) = 0 + on_disk_1d(:) = 0. + on_disk_1d_y(:) = 0. + on_disk_1d_z(:) = 0. + ndiskpt = 0 + do jd = 1, ndisk + do kd = 1, ndisk + if (diskpt(jd)**2 + diskpt(kd)**2 < 1.) then + ndiskpt = ndiskpt + 1 + !on_disk(jd,kd) = 1 + on_disk_1d(ndiskpt) = 1. + on_disk_1d_y(ndiskpt) = diskpt(jd) + on_disk_1d_z(ndiskpt) = diskpt(kd) + endif + end do + end do + + do kt = 1, nt + + if (tb_valid_cur(kt) == 0) cycle ! turbine is turned off or outside of the domain + + it = tbindx(kt) ! tb of interest + + if (num_ups(it) == 0) then + blockfrac(it) = 0. + else + do tt = 1, num_ups(it) + jt = ups_index(it,tt) + scaled_axdist(jt) = ax_dist(it,jt)/(MAXD*2.*radius(jt)) ! scaled by 20*diameter + raxdist(jt) = 1./ax_dist(it,jt) + end do + + nblock = 0 + + on_disk_1d_yr(1:ndiskpt) = on_disk_1d_y(1:ndiskpt)*radius(it) + on_disk_1d_zr(1:ndiskpt) = on_disk_1d_z(1:ndiskpt)*radius(it) + + !--- montecarlo 1 --- + distblk_1d(1:ndiskpt) = on_disk_1d(1:ndiskpt) + rdistblk_1d(1:ndiskpt) = 0. + do ii = 1, ndiskpt ! on tb it + do tt = num_ups(it), 1, -1 ! starting from the closest turbine + jt = ups_index(it,tt) + if ((on_disk_1d_yr(ii) - ay_dist(it,jt))**2 + & ! on tb jt + (on_disk_1d_zr(ii) - az_dist(it,jt))**2 < radius2(jt)) then + nblock = nblock + 1 + distblk_1d(nblock) = scaled_axdist(jt) ! ax_dist(jt)/(20*diameter(it)) + rdistblk_1d(nblock) = raxdist(jt) ! 1./ax_dist(jt) + exit + end if + end do + end do + blockdist(it) = sum(distblk_1d(1:ndiskpt))/ndiskpt + rblockdist(it) = sum(rdistblk_1d(1:ndiskpt))/ndiskpt + !--- montecarlo 1 --- + + + !--- montecarlo 2 --- + !!on_disk and ndiskpt are the same for all turbines, already calculated + !!set distblk(jd,kd) = 1. on turbine (= 0 out of turbine) + !distblk(:,:) = on_disk(:,:)*1.0 + !rdistblk(:,:) = 0. + !do jd = 1, ndisk + !do kd = 1, ndisk + ! if (on_disk(jd,kd) == 1) then ! on turbine it + ! do tt = num_ups(it), 1, -1 ! starting from the closest turbine + ! jt = ups_index(it,tt) + ! if ((diskpt(jd)*radius(it) - ay_dist(it,jt))**2 + & ! on tb jt + ! (diskpt(kd)*radius(it) - az_dist(it,jt))**2 < radius2(jt)) then + ! nblock = nblock + 1 + ! distblk(jd,kd) = scaled_axdist(jt) ! ax_dist(jt)/(20*diameter(it)) + ! rdistblk(jd,kd) = raxdist(jt) ! 1./ax_dist(jt) + ! exit + ! end if + ! end do + ! end if + !end do + !end do + !blockdist(it) = sum(distblk)/ndiskpt + !rblockdist(it) = sum(rdistblk)/ndiskpt + !--- montecarlo 2 --- + + + blockfrac(it) = float(nblock)/ndiskpt + if (blockdist(it) > 1.) blockfrac(it) = 0. + end if ! num_ups(it) > 0 + + !--- + if (blockfrac(it) == 0.) then + gfun_GM = 1. + else + gfun_GM = 0.9615 - 0.1549*blockfrac(it) - 0.0114*rblockdist(it)*20.*2*radius(it) + end if + ulocal(it) = Uinf(it)*gfun_GM + enddo + endif + + + if (cal_method == 1) then + do kt = 1, nt + + if (tb_valid_cur(kt) == 0) cycle ! turbine is turned off or outside of the domain + + it = tbindx(kt) ! tb of interet + call gm_BD_BR_analytical(blockfrac(it), blockdist(it), rblockdist(it), & + radius(it), num_ups(it), ups_index(it,1:nt), nt, it, & + ax_dist(it,1:nt), ytb_rot_gm(it,1:nt)) + if (blockfrac(it) == 0.) then + gfun_GM = 1. + else + gfun_GM = 0.9615 - 0.1549*blockfrac(it) - 0.0114*rblockdist(it)*20.*2*radius(it) + end if + ulocal(it) = Uinf(it)*gfun_GM + enddo + endif + end subroutine cal_tb_ulocal_GM + +!--------------------------------------------------------------- + + subroutine cal_power_wrf_tend(ulocal, uinf, tb_valid_cur, blockfrac, blockdist, u, v, dz, z_at_w, & + ival, jval, nt, radius, diameter, hubheight, area, & + windfarm_model, wfdensity, dt, & + power_nt, power, tke_wk, du_wk, dv_wk, dtheta_avg_cof_i, & + ims,ime,jms,jme,kms,kme,its,itf,jts,jtf) + implicit none + integer :: ims, ime, jms, jme, kms, kme, its, itf, jts, jtf + real, dimension(ims:ime,kms:kme,jms:jme), intent(in) :: u, v, dz, z_at_w + real, dimension(ims:ime,kms:kme,jms:jme) :: tke_wk, du_wk, dv_wk ! wrf output + real, dimension(ims:ime,jms:jme) :: power ! wrf output + real :: power_nt(nt) ! output + real :: dtheta_avg_cof_i !gaussian distribution + + integer :: nt, ival(nt), jval(nt), windfarm_model + real :: ulocal(nt), Uinf(nt), blockfrac(nt), blockdist(nt) + real :: radius(nt), diameter(nt), hubheight(nt), area(nt), wfdensity, dt + integer :: tb_valid_cur(nt) + + integer :: kt, nv, i, j, k + real, dimension(kms:kme) :: speed_z, tarea_z, power2_z, z_tmp + real :: power_GM, power1, power2, ec, tkecof, powcof, thrcof + real :: blade_l_point,blade_u_point,z1,z2 + integer :: k_turbine_bot, k_turbine_top + real :: tmp_spd + + ! turbws, turbtc, turbpwcof, stc, stc2, nval are global varibles, not defined here + + do kt = 1, nt + + if (tb_valid_cur(kt) == 0) cycle ! turbine is turned off or outside of the domain + + ! power for each tb + !IF (windfarm_model == 3) THEN ! GM model + !! YL: For multi-grid cases, I don't have a solution for actual power by GM. + !! It might be scale with the maximun power for the wind farm. + ! IF (blockfrac(kt) == 0.) THEN + ! power_GM = 1. + ! ELSE + ! power_GM = 0.6824 - 0.3405*blockfrac(kt) + 0.2131*blockdist(kt) + ! ENDIF + !ENDIF + + nv = nval(kt) + call dragcof(tkecof, powcof, thrcof, & + ulocal(kt), turbws(kt,1:nv), turbtc(kt,1:nv), & + turbpwcof(kt,1:nv), stc(kt), stc2(kt), nv) + + power1 = 0.5*1.23*ulocal(kt)**3*area(kt)*powcof ! 1.23 density + + power_nt(kt) = power_nt(kt) + power1*dtheta_avg_cof_i + !!------- end power for each tb -------- + + + !----------- WRF tendencies ------------ + ! only considering turbines in the current tile + ! the follwoing code is based on Fitch parameterization + + i = ival(kt) + j = jval(kt) + if (i > itf .or. i < its .or. j > jtf .or. j < jts ) cycle + + ! vertical layers cut by turbine blades + blade_l_point = hubheight(kt) - radius(kt) + blade_u_point = hubheight(kt) + radius(kt) + k_turbine_bot = 0 !bottom level + k_turbine_top = -1 !top level + z_tmp = z_at_w(i,:,j) - z_at_w(i,1,j) + do k = kms, kme-1 + if (blade_l_point >= z_tmp(k) .and. blade_l_point < z_tmp(k+1)) then + k_turbine_bot = k + end if + if (blade_u_point >= z_tmp(k) .and. blade_u_point < z_tmp(k+1)) then + k_turbine_top = k + end if + end do + + ! adjust coef. according to disk averaged power + power2_z(:) = 0. + do k = k_turbine_bot, k_turbine_top ! loop over turbine blade levels + z1 = max(z_tmp(k) - blade_l_point, 0.) + z2 = min(z_tmp(k+1) - blade_l_point, diameter(kt)) + CALL turbine_area(z1, z2, diameter(kt), tarea_z(k)) + + speed_z(k) = ulocal(kt)/Uinf(kt)*sqrt(u(i,k,j)**2 + v(i,k,j)**2) + power2_z(k) = 0.5*1.23*speed_z(k)**3*tarea_z(k)*powcof + end do + power2 = sum(power2_z) + if (power1 == 0. .or. power2 == 0.) then + ec = 1. + else + ec = power1/power2 + end if + !ec = ec*wfdensity + ec = ec*wfdensity*dtheta_avg_cof_i + + power(i,j) = power(i,j) + power2*dtheta_avg_cof_i ! WRF output + + do k = k_turbine_bot, k_turbine_top ! loop over turbine blade levels + !qke_wk(i,k,j) = qke_wk(i,k,j) + speed_z(k)**3*tarea_z(k)*tkecof*dt/dz(i,k,j)*ec + tke_wk(i,k,j) = tke_wk(i,k,j) + 0.5*speed_z(k)**3*tkecof*tarea_z(k)/dz(i,k,j)*dt*ec + du_wk(i,k,j) = du_wk(i,k,j) - 0.5*u(i,k,j)*thrcof*speed_z(k)*tarea_z(k)/dz(i,k,j)*ec + dv_wk(i,k,j) = dv_wk(i,k,j) - 0.5*v(i,k,j)*thrcof*speed_z(k)*tarea_z(k)/dz(i,k,j)*ec + end do + + end do + + end subroutine cal_power_wrf_tend + +!--------------------------------------------------------------- + + subroutine sort_turb(nt, num_ups, ups_index, tbindx) + implicit none + integer, intent(in) :: nt + integer, intent(in) :: num_ups(nt), ups_index(nt,nt) + integer, intent(inout) :: tbindx(nt) + integer :: ic_tb, indx, kt, tt, flag(nt) + + flag(:) = 0 + ic_tb = 0 + + do kt = 1, nt + if (num_ups(kt) == 0) then + ic_tb = ic_tb + 1 + flag(kt) = 1 + tbindx(ic_tb) = kt ! sorted turb starting from upstream + end if + end do + + do while (ic_tb < nt) + do kt = 1, nt + if (flag(kt) == 1) cycle + + do tt = 1, num_ups(kt) + indx = ups_index(kt,tt) + if (flag(indx) == 0) exit + + if (tt == num_ups(kt)) then + ic_tb = ic_tb + 1 + flag(kt) = 1 + tbindx(ic_tb) = kt + end if + end do + end do + enddo + + if (sum(flag) < nt) then + write(*,*) 'something wrong in sorting turbine, wind_jensen/sort_turb' + write(*,*) tbindx + stop + end if + + endsubroutine sort_turb + +!--------------------------------------------------------------- + + subroutine sort_gm(nturb, tbindx, ax_dist) + implicit none + integer, intent(in) :: nturb + integer, intent(out), dimension(nturb) :: tbindx + real, intent(inout), dimension(nturb) :: ax_dist + real, dimension(nturb) :: xloc + integer :: i, a(1) + real :: xmin + integer :: tbindx_cp(nturb) + + xloc = ax_dist + tbindx_cp = tbindx + xmin = minval(xloc) - 1. + + do i = 1, nturb + a = maxloc(xloc) + tbindx(i) = tbindx_cp(a(1)) + xloc(a(1)) = xmin + end do + + end subroutine sort_gm + +!--------------------------------------------------------------- + +!--------------------------------------------------------------- + + subroutine gm_BD_BR_analytical(blockfrac, blockdist, rblockdist, & + radius, num_ups, ups_index, nt, it, ax_dist, y) + implicit none + integer :: nt, num_ups, it + integer :: ups_index(nt) + real :: ax_dist(nt), y(nt) + real :: scaled_axdist(nt), raxdist(nt) + real :: radius + real, intent(out) :: blockfrac, blockdist, rblockdist + + real, parameter :: MAXD = 20. ! upsteam within 20d + integer, parameter :: ndisk = 80 + real :: diameter, radius2, d, BR, BD, mindr, mindl + integer :: tt, jt, numuptl, numuptr, jmindisl, jmindisr + real :: blockdist_ups(nt), blockfrac_ups(nt), rblockdist_ups(nt) + + if (num_ups == 0) then + blockfrac = 0. + return + endif + + diameter = radius*2 + radius2 = radius**2 + + blockfrac_ups(:) = 0. + blockdist_ups(:) = 0. + rblockdist_ups(:) = 0. + + mindr = diameter + mindl = diameter + numuptl = 0 + numuptr = 0 + jmindisl = 0 + jmindisr = 0 + + ! only look for 4 upstream turbines ??? YL + + do tt = num_ups, 1, -1 ! starting from the closest turbine + jt = ups_index(tt) + if (ax_dist(jt) > maxd*diameter) exit ! only consider ups tbs within 20d + + !-------------------- + d = y(jt) - y(it) + + if (d <= 0.) then !upstream turbine on the left side of (or on) the centerline + numuptl = numuptl + 1 + if (abs(d) > mindl) then + blockfrac_ups(jt) = 0. + else + if (numuptl == 1) then + if (numuptr == 0) then + blockfrac_ups(jt) = Ao_GM(y(it), y(jt), radius) + else + if ( abs(d) + mindr < diameter ) then + blockfrac_ups(jt) = Ao_GM(y(it), y(jt), radius) - & + Ao_GM(y(jt), y(jmindisr), radius) + else + blockfrac_ups(jt) = Ao_GM(y(it), y(jt), radius) + end if + end if + else + if (numuptr > 0 .and. abs(d) + mindr < diameter) then + if (mindr + mindl < diameter) then + blockfrac_ups(jt) = Ao_GM(y(it), y(jt), radius) - & + Ao_GM(y(it), y(jmindisl), radius) - & + Ao_GM(y(jt), y(jmindisr), radius) + & + Ao_GM(y(jmindisl), y(jmindisr), radius) + else + blockfrac_ups(jt) = Ao_GM(y(it), y(jt), radius) - & + Ao_GM(y(it), y(jmindisl), radius) - & + Ao_GM(y(jt), y(jmindisr), radius) + end if + else + if (mindr + mindl < diameter) then + blockfrac_ups(jt) = Ao_GM(y(it), y(jt), radius) - & + Ao_GM(y(it), y(jmindisl), radius) + & + Ao_GM(y(jmindisl), y(jmindisr), radius) + else + blockfrac_ups(jt) = Ao_GM(y(it), y(jt), radius) - & + Ao_GM(y(it), y(jmindisl), radius) + end if + end if + end if + mindl = abs(d) + jmindisl = jt + + ! don't need to look for further ups tbs + if (d == 0.) then + blockdist_ups(jt) = blockfrac_ups(jt)*ax_dist(jt)/(MAXD*diameter) + rblockdist_ups(jt) = blockfrac_ups(jt)/ax_dist(jt) + exit + end if + + end if + + else !upstream turbine on the right side of the centerline + numuptr = numuptr + 1 + if (abs(d) > mindr) then + blockfrac_ups(jt) = 0. + else + if (numuptr == 1) then + if (numuptl == 0) then + blockfrac_ups(jt) = Ao_GM(y(it), y(jt), radius) + else + if ( abs(d) + mindl < diameter ) then + blockfrac_ups(jt) = Ao_GM(y(it), y(jt), radius) - & + Ao_GM(y(jt), y(jmindisl), radius) + else + blockfrac_ups(jt) = Ao_GM(y(it), y(jt), radius) + end if + end if + else + if (numuptl > 0 .and. abs(d) + mindl < diameter) then + if (mindr + mindl < diameter) then + blockfrac_ups(jt) = Ao_GM(y(it), y(jt), radius) - & + Ao_GM(y(it), y(jmindisr), radius) - & + Ao_GM(y(jt), y(jmindisl), radius) + & + Ao_GM(y(jmindisl), y(jmindisr), radius) + else + blockfrac_ups(jt) = Ao_GM(y(it), y(jt), radius) - & + Ao_GM(y(it), y(jmindisr), radius) - & + Ao_GM(y(jt), y(jmindisl), radius) + end if + else + if (mindr + mindl < diameter) then + blockfrac_ups(jt) = Ao_GM(y(it), y(jt), radius) - & + Ao_GM(y(it), y(jmindisr), radius) + & + Ao_GM(y(jmindisl), y(jmindisr), radius) + else + blockfrac_ups(jt) = Ao_GM(y(it), y(jt), radius) - & + Ao_GM(y(it), y(jmindisr), radius) + end if + end if + end if + mindr = abs(d) + jmindisr = jt + end if + end if !center, left and right are all done for blockfrac_ups(jt) + + blockdist_ups(jt) = blockfrac_ups(jt)*ax_dist(jt)/(MAXD*diameter) + rblockdist_ups(jt) = blockfrac_ups(jt)/ax_dist(jt) + + end do + + BR = sum(blockfrac_ups) + BD = sum(blockdist_ups) + 1.*(1.-BR) ! normalized dist for non-blocked part is 1. + + blockfrac = BR + blockdist = BD + rblockdist = sum(rblockdist_ups) + + if (blockdist > 1.) blockfrac = 0. + + end subroutine gm_BD_BR_analytical + +!--------------------------------------------------------------- + + function Ao_GM(x1, x2, Radius) result(Ao) + implicit none + real,intent(in) :: x1,x2,Radius + real :: Ao + real :: d, l, theta, Asector, Atriangle + + Ao = 0. + d = sqrt((x1-x2)**2) + if (d<2*Radius) then + l = d/2. !Improve later in case hubs are not at same height + theta = 2 * acos(l/Radius) + Asector = theta/2.*Radius**2 + Atriangle = l*Radius*sin(theta/2.) + Ao = 2*(Asector - Atriangle)/(piconst*radius**2) + end if + + end function Ao_GM + +!--------------------------------------------------------------- + + function AreaOverlap(y1, y2, z1, z2, r1, r2) result(AOverlap) + implicit none + real,intent(in) :: y1, y2, z1, z2, r1, r2 + real :: AOverlap + real :: c, CBD, CAD + + c = sqrt((z1-z2)**2 + (y1-y2)**2) + + if ((c + min(r2,r1)) <= max(r2,r1)) then + AOverlap = piconst*min(r2,r1)**2 + else if ((r1 + r2) <= c) then + AOverlap = 0. + else + CBD = acos((r2**2 + c**2 - r1**2)/(2*r2*c)) + CAD = acos((r1**2 + c**2 - r2**2)/(2*r1*c)) + AOverlap = CBD*r2**2 + CAD*r1**2 - 0.5*r2**2*sin(2*CBD) - 0.5*r1**2*sin(2*CAD) + !AOverlap = CBD*r2**2 + CAD*r1**2 - r1*c*sin(CAD) + end if + + end function AreaOverlap + +!--------------------------------------------------------------- + + function find_turb(xc, yc, xt, yt, u, v, sr_angle, sr_dis) result(ft) + implicit none + logical :: ft + real :: xc, yc, xt, yt, sr_angle, sr_dis, u, v + real :: posi_angle, posi_dis, spd, xp, yp, angle + real ( kind = 8 ) :: tmp1, tmp2 + + ft = .false. + + xp = xt - xc + yp = yt - yc + posi_dis = sqrt(yp**2 + xp**2) + + if (posi_dis <= sr_dis) then + posi_angle = atan2(-yp, -xp) + spd = sqrt(u**2 + v**2) + !tmp1 = -(u*xp + v*yp) ! negative means ups diretion + tmp1 = real( -(u*xp + v*yp), kind = 8 ) + tmp2 = real( sqrt( (u**2 + v**2) * (xp**2 + yp**2) ), kind = 8) + + if (abs(tmp2) < abs(tmp1)) then + tmp2 = sign(tmp1,tmp2) + end if + + angle = real(acos(tmp1/tmp2), kind = 4) + + if (isnan(angle)) then + angle = 0. + end if + + if (abs(angle) <= sr_angle) then + ft = .true. + end if + end if + + end function find_turb + +!--------------------------------------------------------------- + + subroutine coordinate_rotation(xr, yr, x, y, theta) + implicit none + real :: xr, yr, x, y, theta + xr = x*cos(theta) + y*sin(theta) + yr = -x*sin(theta) + y*cos(theta) + end subroutine coordinate_rotation + +!--------------------------------------------------------------- + + subroutine Gaussian_integral(ch, ck, R, sigma_x, sigma_y, avg_val) + ! integration of Gaussian distribution over an offset circle: + ! (x-ch)**2 + (y-ck)**2 <= R**2 + ! DiDonato and Jarnagin, 1961 + implicit none + real, intent(in) :: ch, ck, R, sigma_x, sigma_y + real :: d01, d11, t, A, P, avg_val, sum_val + real :: WW(24), XX(24) ! 24 point gaussian quadrature integral for 1D function + integer :: i + + ! https://pomax.github.io/bezierinfo/legendre-gauss.html + WW( 1)=0.1279381953467522; XX( 1)= -0.0640568928626056 + WW( 2)=0.1279381953467522; XX( 2)= 0.0640568928626056 + WW( 3)=0.1258374563468283; XX( 3)= -0.1911188674736163 + WW( 4)=0.1258374563468283; XX( 4)= 0.1911188674736163 + WW( 5)=0.1216704729278034; XX( 5)= -0.3150426796961634 + WW( 6)=0.1216704729278034; XX( 6)= 0.3150426796961634 + WW( 7)=0.1155056680537256; XX( 7)= -0.4337935076260451 + WW( 8)=0.1155056680537256; XX( 8)= 0.4337935076260451 + WW( 9)=0.1074442701159656; XX( 9)= -0.5454214713888396 + WW(10)=0.1074442701159656; XX(10)= 0.5454214713888396 + WW(11)=0.0976186521041139; XX(11)= -0.6480936519369755 + WW(12)=0.0976186521041139; XX(12)= 0.6480936519369755 + WW(13)=0.0861901615319533; XX(13)= -0.7401241915785544 + WW(14)=0.0861901615319533; XX(14)= 0.7401241915785544 + WW(15)=0.0733464814110803; XX(15)= -0.8200019859739029 + WW(16)=0.0733464814110803; XX(16)= 0.8200019859739029 + WW(17)=0.0592985849154368; XX(17)= -0.8864155270044011 + WW(18)=0.0592985849154368; XX(18)= 0.8864155270044011 + WW(19)=0.0442774388174198; XX(19)= -0.9382745520027328 + WW(20)=0.0442774388174198; XX(20)= 0.9382745520027328 + WW(21)=0.0285313886289337; XX(21)= -0.9747285559713095 + WW(22)=0.0285313886289337; XX(22)= 0.9747285559713095 + WW(23)=0.0123412297999872; XX(23)= -0.9951872199970213 + WW(24)=0.0123412297999872; XX(24)= 0.9951872199970213 + + sum_val = 0. + do i = 1, 24 ! 24 point gaussian quadrature integral + t = 0.5*XX(i) + 0.5 + d01 = (ck - R*t*sqrt(2.-t**2))/(sqrt(2.)*sigma_y) + d11 = (ck + R*t*sqrt(2.-t**2))/(sqrt(2.)*sigma_y) + P = (exp(-0.5*( (ch - R*(1.-t**2))/sigma_x )**2) + & + exp(-0.5*( (ch + R*(1.-t**2))/sigma_x )**2)) * & + (erf(d11) - erf(d01))*t + sum_val = sum_val + 0.5*WW(i)*P + end do + !A = R/sigma_y/np.sqrt(2*np.pi) ! normalized gaussian distribution + A = (2*piconst*sigma_x*sigma_y) * R/sigma_x/sqrt(2*piconst) + avg_val = A*sum_val/(piconst*R**2) + + end subroutine Gaussian_integral + +!--------------------------------------------------------------- + + subroutine to_zk2(obs_v, mdl_v, mdl_data, iz, interp_out ) + ! 1D interp function + implicit none + integer :: k, iz, k1 + real, intent(in) :: obs_v + real, dimension(1:iz), intent(in) :: mdl_v, mdl_data + real, intent(out) :: interp_out + real :: dz, dzm, zk + + if (obs_v < mdl_v(1) ) then + interp_out = mdl_data(1) + return + else if (obs_v >= mdl_v(iz)) then + interp_out = mdl_data(iz) + return + else + do k = 1,iz-1 + if(obs_v >= mdl_v(k) .and. obs_v < mdl_v(k+1)) then + zk = real(k) + (obs_v - mdl_v(k))/(mdl_v(k+1) - mdl_v(k)) + exit + end if + end do + k1 = int( zk ) + dz = zk - float( k1 ) + dzm = float( k1+1 ) - zk + + interp_out = dzm*mdl_data(k1) + dz*mdl_data(k1+1) + return + end if + + end subroutine to_zk2 + +!--------------------------------------------------------------- + + subroutine turbine_area(z1, z2, tdiameter, tarea) + ! This subroutine calculates area of turbine between two vertical levels + ! Input variables : + ! z1 = distance between k level and lower blade tip + ! z2 = distance between k+1 level and lower blade tip + ! wfdensity = wind farm density in m^-2 + ! tdiameter = turbine diameter + ! Output variable : + ! tarea = area of turbine between two levels + implicit none + real, intent(in) :: tdiameter + real, intent(inout) :: z1, z2 + real, intent(out):: tarea + real r, zc1, zc2 + + r = 0.5*tdiameter !r = turbine radius + z1 = r - z1 !distance of kth level from turbine center + z2 = r - z2 !distance of k+1 th level from turbine center + zc1 = abs(z1) + zc2 = abs(z2) + + ! turbine area between z1 and z2 + if(z1 > 0. .and. z2 > 0.) then + tarea = zc1*sqrt(r*r - zc1*zc1) + r*r*asin(zc1/r) - & + zc2*sqrt(r*r - zc2*zc2) - r*r*asin(zc2/r) + else if(z1 < 0. .and. z2 < 0.) then + tarea = zc2*sqrt(r*r - zc2*zc2) + r*r*asin(zc2/r) - & + zc1*sqrt(r*r - zc1*zc1) - r*r*asin(zc1/r) + else + tarea = zc2*sqrt(r*r - zc2*zc2) + r*r*asin(zc2/r) + & + zc1*sqrt(r*r - zc1*zc1) + r*r*asin(zc1/r) + end if + + end subroutine turbine_area + +!--------------------------------------------------------------- + + subroutine dragcof(tkecof, powcof, thrcof, speed, & + turb_ws, turb_tc, turb_pwcof, stdthrcoef, stdthrcoef2, nv) + implicit none + real, intent(in):: speed, stdthrcoef, stdthrcoef2 + integer :: nv + real, dimension(1:nv) :: turb_ws, turb_tc, turb_pwcof + real, intent(out):: tkecof,powcof,thrcof + real :: cispeed, cospeed + + cispeed = turb_ws(1) + cospeed = turb_ws(nv) + + if (speed < cispeed) then + thrcof = stdthrcoef + powcof = 0. + else if (speed > cospeed) then + thrcof = stdthrcoef2 + powcof = 0. + else + call to_zk2(speed, turb_ws(1:nv), turb_tc(1:nv), nv, thrcof) + call to_zk2(speed, turb_ws(1:nv), turb_pwcof(1:nv), nv, powcof) + endif + + ! tke coefficient calculation + tkecof = max(0., thrcof-powcof) !Cri: consider multiplying by 0.5 or so + tkecof = correction_factor * tkecof + !tkecof = 0.25*tkecof ! Yulong + + end subroutine dragcof + +!--------------------------------------------------------------- + +#if defined(mpas) + SUBROUTINE point_in_polyogon(find, px, py, xcell, ycell, dv) + implicit none + + ! dv: side length of hexgon + real, intent(in) :: px, py, xcell, ycell, dv + real :: xx, yy + logical :: find + + xx = abs(px - xcell) + yy = abs(py - ycell) + + find = .false. + if (xx <= dv .and. yy <= sqrt(3.)/2.*dv) then ! in the outer rectangle + if (dv - xx >= yy/sqrt(3.) ) find = .true. + endif + + END SUBROUTINE point_in_polyogon + +!--------------------------------------------------------------- + + ! called in core_atmosphere/physics/mpas_atmphys_init.F + subroutine init_module_wind_jensen_MPAS(dminfo, windfarm_ij, windfarm_deg, & + xcell, ycell, ncells, dc) + implicit none + type(dm_info),intent(in) :: dminfo + integer :: ncells + integer, parameter :: id = 1 + integer :: windfarm_ij + real :: windfarm_deg + real :: dc, dv + real, dimension(ncells), intent(in) :: xcell, ycell !hexgon cell center +! + real :: lat,lon,ts_rx,ts_ry + real :: known_lat, known_lon + integer :: i,j,k,ios, igs, jgs + + real :: x_rot, y_rot, theta, deg, xtb_center, ytb_center, xp, yp + logical :: find + character*256 num,input + + if (windfarm_initialized) return + + windfarm_initialized = .true. + + dv = sqrt(3.)/3.*dc + + if (windfarm_ij == 1) then + open(71,file='windturbines-xy.txt',form='formatted',status='old',iostat=ios) + else if (windfarm_ij == 2) then + open(71,file='windturbines-ll.txt',form='formatted',status='old',iostat=ios) + end if + + nt = 0 + do + read(71, *, iostat=ios) + if (ios /= 0) exit + nt = nt + 1 + end do + close(71) + + allocate (nkind(nt),nval(nt),ival(nt,max_domains),jval(nt,max_domains)) + allocate (xturb(nt,max_domains),yturb(nt,max_domains)) + allocate (hubheight(nt),stc(nt),stc2(nt),area(nt),radius(nt),radius2(nt),diameter(nt),npower(nt)) + allocate(turbws(nt,MAXVALS),turbtc(nt,MAXVALS),turbpw(nt,MAXVALS),turbpwcof(nt,MAXVALS)) + + xturb = -9999. + yturb = -9999. + ival = -9999 + jval = -9999 + turbws = 0. + turbtc = 0. + turbpw = 0. + turbpwcof = 0. + + if (windfarm_ij == 1) then + open(71,file='windturbines-xy.txt',form='formatted',status='old',iostat=ios) + do k = 1, nt + nkind(k) = 1 + read(71,*) xturb(k,id), yturb(k,id) + enddo + close(71) + + !------- set wind farm center coordinate to (0,0) --- + xtb_center = sum(xturb(1:nt,id))/nt + ytb_center = sum(yturb(1:nt,id))/nt + do k = 1, nt + xturb(k,id) = xturb(k,id) - xtb_center + yturb(k,id) = yturb(k,id) - ytb_center + end do + !----------------------------------------------------- + + !------- rotate wind farm ------- + deg = windfarm_deg + do k = 1, nt + !theta = -30./180.*piconst ! d255: 225 - 255 = -30 + + theta = deg/180.*piconst + call coordinate_rotation(x_rot, y_rot, xturb(k,id), yturb(k,id), theta) + xturb(k,id) = x_rot + yturb(k,id) = y_rot + end do + !------------------------------- + + !!-------------- find ix, iy ----------------- + + igs = 10 + jgs = 12 + ival(:,id) = -9999 + jval(:,id) = 1 + DO k = 1, nt + xp = xturb(k,id) + igs*sqrt(3.)/2.*dc + yp = yturb(k,id) + jgs*sqrt(3.)/2.*dc + DO i = 1, ncells + call point_in_polyogon(find, xp, yp, xcell(i), ycell(i), dv) + IF (find) THEN + ival(k,id) = i + EXIT + ENDIF + ENDDO + ENDDO + + !write(*,*) 'MPAS loc0:', ival(:,id) + !call mpas_dmpar_bcast_ints(dminfo, nt, ival(:,id)) + + ! ---- test in one cell --- + !ival(:,id) = ival(1,id) + !write(*,*) 'MPAS loc:', ival(1,id) + write(*,*) 'MPAS loc:' + do k = 1, nt + write(*,*) k, ival(k,id) + end do + !write(*,*) 'xcell:', xcell(1), xcell(ncells) + !write(*,*) 'ycell:', ycell(1), ycell(ncells) + ! ---- test in one cell --- + !!-------------- end find ix, iy ----------- + + do k = 1, nt + write(num,*) nkind(k) + num = adjustl(num) + input = "wind-turbine-"//trim(num)//".tbl" + open(file=trim(input),unit=19,form='formatted',status='old') + read(19,*) nval(k) + read(19,*) hubheight(k), diameter(k), stc(k), npower(k) + + area(k)=piconst/4.*diameter(k)**2 + + do i = 1, nval(k) + read(19,*) turbws(k,i), turbtc(k,i), turbpw(k,i) + turbpwcof(k,i) = turbpw(k,i)*1000./(0.5*1.23*turbws(k,i)**3*area(k)) + end do + + radius(k) = 0.5*diameter(k) + radius2(k) = radius(k)**2 + stc2(k) = turbtc(k,nval(k)) + close (19) + end do + endif + + end subroutine init_module_wind_jensen_MPAS + +!--------------------------------------------------------------- +#else + +subroutine cal_xturb_yturb(lat_nt, lon_nt, wf_id_nt, nt, xturb_nt, yturb_nt) + implicit none + integer :: nt + real(kind=8) :: lat_nt(nt), lon_nt(nt) + integer :: wf_id_nt(nt) + real(kind=8) :: xturb_nt(nt), yturb_nt(nt) + + integer :: ic, wf_id, k, kk, ik, mid_ic, nn + real(kind=8) :: lon_tmp(nt), lat_wf(nt), lon_wf(nt) + real(kind=8) :: lon_center, x, y + real(kind=8) :: x_center, y_center + real(kind=8) :: off_dist = 600000. ! used to seprate wind farms + integer :: num_wf + + num_wf = 1 + + ik = 1 + ic = 1 + wf_id = wf_id_nt(1) + lon_tmp(ic) = lon_nt(1) + lat_wf(ic) = lat_nt(1) + lon_wf(ic) = lon_nt(1) + do k = 2, nt + if (wf_id_nt(k) == wf_id) then + ic = ic + 1 + lon_tmp(ic) = lon_nt(k) + lat_wf(ic) = lat_nt(k) + lon_wf(ic) = lon_nt(k) + else if (wf_id_nt(k) /= wf_id) then + call shell_sort_1D(lon_tmp(1:ic),ic) + mid_ic = ceiling(ic*0.5) + lon_center = lon_tmp(mid_ic) + + x_center = 0. + y_center = 0. + do kk = 1, ic + call latlon_to_xy(lat_wf(kk), lon_wf(kk), lon_center, x, y) + !call latlon_to_xy(lat_wf(kk), lon_wf(kk), real(9.,kind=8), x, y) !Anholt test + xturb_nt(ik) = x + yturb_nt(ik) = y + x_center = x_center + x + y_center = y_center + y + ik = ik + 1 + enddo + + x_center = x_center/ic + y_center = y_center/ic + do kk = ik-ic, ik-1 + xturb_nt(kk) = xturb_nt(kk) - x_center + yturb_nt(kk) = yturb_nt(kk) - y_center + num_wf*off_dist! off set distance for wind farm [m] + enddo + + num_wf = num_wf + 1 + ic = 1 + wf_id = wf_id_nt(k) + lon_tmp(ic) = lon_nt(k) + lat_wf(ic) = lat_nt(k) + lon_wf(ic) = lon_nt(k) + endif + enddo + + call shell_sort_1D(lon_tmp(1:ic),ic) + mid_ic = ceiling(ic*0.5) + lon_center = lon_tmp(mid_ic) + + x_center = 0. + y_center = 0. + do kk = 1, ic + call latlon_to_xy(lat_wf(kk), lon_wf(kk), lon_center, x, y) + !call latlon_to_xy(lat_wf(kk), lon_wf(kk), real(9.,kind=8), x, y) !Anholt test + xturb_nt(ik) = x + yturb_nt(ik) = y + x_center = x_center + x + y_center = y_center + y + ik = ik + 1 + enddo + + x_center = x_center/ic + y_center = y_center/ic + do kk = ik-ic, ik-1 + xturb_nt(kk) = xturb_nt(kk) - x_center + yturb_nt(kk) = yturb_nt(kk) - y_center + num_wf*off_dist ! off set distance for wind farm [m] + enddo + +end subroutine cal_xturb_yturb + +!------------------------------ + +subroutine latlon_to_xy(latitude, longitude, central_lon, easting, northing) +! from https://github.com/Turbo87/utm/blob/master/utm/conversion.py + implicit none + real(kind=8), intent(in) :: latitude, longitude, central_lon + real(kind=8), intent(out) :: easting, northing + + real(kind=8), PARAMETER :: pi = 3.141592653589793 + real(kind=8) :: lat_rad, lat_sin, lat_cos, lat_tan, lat_tan2, lat_tan4 + real(kind=8) :: lon_rad + real(kind=8) :: central_lon_rad, dlon_rad + + real(kind=8), PARAMETER :: K0 = 0.9996 + real(kind=8), PARAMETER :: E = 0.00669438 + real(kind=8), PARAMETER :: R = 6378137. + real(kind=8) :: E2, E3, E_P2, SQRT_E + real(kind=8) :: XE, XE2, XE3, XE4, XE5 + real(kind=8) :: M1, M2, M3, M4, P2, P3, P4, P5 + real(kind=8) :: n, c, a, a2, a3, a4, a5, a6, m + + lat_rad = latitude*pi/180. + lat_sin = sin(lat_rad) + lat_cos = cos(lat_rad) + + lat_tan = lat_sin / lat_cos + lat_tan2 = lat_tan * lat_tan + lat_tan4 = lat_tan2 * lat_tan2 + + lon_rad = longitude*pi/180. + + ! differenct from UTM, set center lon at the wind farm center + central_lon_rad = central_lon*pi/180. + + ! -pi to pi + dlon_rad = mod(lon_rad - central_lon_rad + pi, 2*pi) - pi + + E2 = E * E + E3 = E2 * E + E_P2 = E / (1. - E) + + SQRT_E = sqrt(1. - E) + + XE = (1. - SQRT_E) / (1. + SQRT_E) + XE2 = XE * XE + XE3 = XE2 * XE + XE4 = XE3 * XE + XE5 = XE4 * XE + + M1 = (1. - E / 4. - 3. * E2 / 64. - 5. * E3 / 256.) + M2 = (3. * E / 8. + 3. * E2 / 32. + 45. * E3 / 1024.) + M3 = (15. * E2 / 256. + 45. * E3 / 1024.) + M4 = (35. * E3 / 3072.) + + P2 = (3. / 2. * XE - 27. / 32. * XE3 + 269. / 512. * XE5) + P3 = (21. / 16. * XE2 - 55. / 32. * XE4) + P4 = (151. / 96. * XE3 - 417. / 128. * XE5) + P5 = (1097. / 512. * XE4) + + + n = R / sqrt(1. - E * lat_sin**2) + c = E_P2 * lat_cos**2 + + a = lat_cos * dlon_rad + a2 = a * a + a3 = a2 * a + a4 = a3 * a + a5 = a4 * a + a6 = a5 * a + + m = R * (M1 * lat_rad - & + M2 * sin(2. * lat_rad) + & + M3 * sin(4. * lat_rad) - & + M4 * sin(6. * lat_rad)) + + easting = K0 * n * (a + & + a3 / 6. * (1. - lat_tan2 + c) + & + a5 / 120. * (5. - 18. * lat_tan2 + lat_tan4 + 72. * c - 58. * E_P2)) + 500000. + + northing = K0 * (m + n * lat_tan * & + (a2 / 2. + & + a4 / 24. * (5. - lat_tan2 + 9. * c + 4. * c**2) + & + a6 / 720. * (61. - 58. * lat_tan2 + lat_tan4 + 600. * c - 330. * E_P2))) + +! if (latitude < 0.) northing = northing + 10000000. + +end subroutine latlon_to_xy + +!------------------------------ + +subroutine shell_sort_1D(AA, n) + implicit none + integer :: n, k + real(kind=8), dimension(1:n) :: AA + integer :: i,j + real(kind=8) :: A_tmp + integer :: B_tmp + k=n/2 + do while( k>0 ) + do i=k+1,n + j=i-k + do while( j>0 ) + if ( AA(j) .gt. AA(j+k) ) then + A_tmp = AA(j) + AA(j) = AA(j+k) + AA(j+k) = A_tmp + + j=j-k + else + exit + end if + end do + end do + k=k/2 + end do + +end subroutine shell_sort_1D + + subroutine init_module_wind_mav(id,config_flags,xlong,xlat,windfarm_initialized,dx,& + ims,ime,jms,jme,its,ite,jts,jte,ids,ide,jds,jde) + USE module_date_time ! must within subroutine, module_date_time.F ../share/ + implicit none + integer :: ims,ime,jms,jme,ids,ide,jds,jde + integer :: its,ite,jts,jte + real :: dx + real, dimension(ims:ime, jms:jme), intent(in) :: xlong,xlat + + type (grid_config_rec_type) :: config_flags + type (proj_info) :: ts_proj + logical :: windfarm_initialized ! WRF + character*256 num,input,message_wind + real :: lat,lon,ts_rx,ts_ry + real :: known_lat, known_lon + integer :: i,j,k,id,ios, igs, jgs + + real :: xgrid(ide), ygrid(jde), tmp + real :: x_rot, y_rot, theta, deg, xtb_center, ytb_center + + logical, external :: wrf_dm_on_monitor + + + !--- local --- + real(kind=8), dimension(:), allocatable :: lat_nt, lon_nt, xturb_nt, yturb_nt + integer, dimension(:), allocatable :: wf_id_nt + !--- local --- + + !--------- + logical :: lexist + CHARACTER (LEN=24) :: date_str + INTEGER:: julyr + INTEGER:: julday + REAL :: gmt + real(kind=8) :: calday + + !IF ( windfarm_initialized) RETURN + + correction_factor = config_flags%windfarm_tke_factor + + ! get turbine number nt + if ( wrf_dm_on_monitor() ) then + if (config_flags%windfarm_ij == 1) then + open(71,file='windturbines-xy.txt',form='formatted',status='old',iostat=ios) + else if (config_flags%windfarm_ij == 2) then + open(71,file='windturbines-ll.txt',form='formatted',status='old',iostat=ios) + end if + + nt = 0 + do + read(71, *, iostat=ios) + if (ios /= 0) exit + nt = nt + 1 + end do + close(71) + end if + + call wrf_dm_bcast_integer(nt,1) + + if (.not. windfarm_initialized) then + allocate (nkind(nt),nval(nt),ival(nt,max_domains),jval(nt,max_domains)) + allocate (xturb(nt,max_domains),yturb(nt,max_domains)) + allocate (hubheight(nt),stc(nt),stc2(nt),area(nt),radius(nt),radius2(nt),diameter(nt),npower(nt)) + allocate(turbws(nt,MAXVALS),turbtc(nt,MAXVALS),turbpw(nt,MAXVALS),turbpwcof(nt,MAXVALS)) + + allocate (xturb_nt(nt),yturb_nt(nt)) + allocate (lat_nt(nt),lon_nt(nt)) + allocate (wf_id_nt(nt)) + + turbws = 0. + turbtc = 0. + turbpw = 0. + turbpwcof = 0. + nkind(:) = 1 + + windfarm_initialized = .true. + end if + + if (.not. allocated(nkind)) allocate(nkind(nt)) + if (.not. allocated(nval)) allocate(nval(nt)) + if (.not. allocated(ival)) allocate(ival(nt,max_domains)) + if (.not. allocated(jval)) allocate(jval(nt,max_domains)) + if (.not. allocated(xturb)) allocate(xturb(nt,max_domains)) + if (.not. allocated(yturb)) allocate(yturb(nt,max_domains)) + if (.not. allocated(hubheight)) allocate(hubheight(nt)) + if (.not. allocated(stc)) allocate(stc(nt)) + if (.not. allocated(stc2)) allocate(stc2(nt)) + if (.not. allocated(area)) allocate(area(nt)) + if (.not. allocated(radius)) allocate(radius(nt)) + if (.not. allocated(radius2)) allocate(radius2(nt)) + if (.not. allocated(diameter)) allocate(diameter(nt)) + if (.not. allocated(npower)) allocate(npower(nt)) + if (.not. allocated(turbws)) allocate(turbws(nt,maxvals)) + if (.not. allocated(turbtc)) allocate(turbtc(nt,maxvals)) + if (.not. allocated(turbpw)) allocate(turbpw(nt,maxvals)) + if (.not. allocated(turbpwcof)) allocate(turbpwcof(nt,maxvals)) + + if (.not. allocated(xturb_nt)) allocate(xturb_nt(nt)) + if (.not. allocated(yturb_nt)) allocate(yturb_nt(nt)) + if (.not. allocated(lat_nt)) allocate(lat_nt(nt)) + if (.not. allocated(lon_nt)) allocate(lon_nt(nt)) + if (.not. allocated(wf_id_nt)) allocate(wf_id_nt(nt)) + + xturb(:,id) = -9999. + yturb(:,id) = -9999. + ival(:,id) = -9999 + jval(:,id) = -9999 + + ! + ! --- find turbine location --- + ! + if ( wrf_dm_on_monitor() ) then + + ! real case, based on lat, lon + if (config_flags%windfarm_ij == 2) then + CALL map_init(ts_proj) + open(71,file='windturbines-ll.txt',form='formatted',status='old',iostat=ios) + + do k = 1, nt + !read(71,*) lat, lon + read(71,*) lat_nt(k), lon_nt(k), wf_id_nt(k), nkind(k) + lat = lat_nt(k) + lon = lon_nt(k) + known_lat = xlat(its,jts) + known_lon = xlong(its,jts) + + ! Mercator + if (config_flags%map_proj == PROJ_MERC) then + call map_set(PROJ_MERC, ts_proj, & + truelat1 = config_flags%truelat1, & + lat1 = known_lat, & + lon1 = known_lon, & + knowni = REAL(its), & + knownj = REAL(jts), & + dx = config_flags%dx) + + ! Lambert conformal + else if (config_flags%map_proj == PROJ_LC) then + call map_set(PROJ_LC, ts_proj, & + truelat1 = config_flags%truelat1, & + truelat2 = config_flags%truelat2, & + stdlon = config_flags%stand_lon, & + lat1 = known_lat, & + lon1 = known_lon, & + knowni = REAL(its), & + knownj = REAL(jts), & + dx = config_flags%dx) + + ! Polar stereographic + else if (config_flags%map_proj == PROJ_PS) then + call map_set(PROJ_PS, ts_proj, & + truelat1 = config_flags%truelat1, & + stdlon = config_flags%stand_lon, & + lat1 = known_lat, & + lon1 = known_lon, & + knowni = REAL(its), & + knownj = REAL(jts), & + dx = config_flags%dx) + end if + + call latlon_to_ij(ts_proj, lat, lon, ts_rx, ts_ry) + + ival(k,id)=nint(ts_rx) + jval(k,id)=nint(ts_ry) +! write(*,*) 'sss', id, k, ts_rx + if (ival(k,id).lt.ids.and.ival(k,id).gt.ide) then + ival(k,id) = -9999 + jval(k,id) = -9999 + end if + + end do + close(71) + + !--- cal turbine locations (x,y in [m]) based on (lat, lon) + call cal_xturb_yturb(lat_nt, lon_nt, wf_id_nt, nt, xturb_nt, yturb_nt) + do k = 1, nt + xturb(k,id) = xturb_nt(k) + yturb(k,id) = yturb_nt(k) + !write(*,*) xturb(k,id), yturb(k,id) + end do + + end if ! windfarm_ij == 2 + + ! ideal case, based on x, y (m) + if (config_flags%windfarm_ij == 1) then + open(71,file='windturbines-xy.txt',form='formatted',status='old',iostat=ios) + do k = 1, nt + read(71,*) xturb(k,id), yturb(k,id), wf_id_nt(k), nkind(k) + !read(71,*) xturb(k,id), yturb(k,id) + ! wf_id_nt(k) = 1 + ! nkind(k) = 1 + enddo + close(71) + + ! reset wind farm center coordinate to (0,0) + xtb_center = sum(xturb(1:nt,id))/nt + ytb_center = sum(yturb(1:nt,id))/nt + do k = 1, nt + xturb(k,id) = xturb(k,id) - xtb_center + yturb(k,id) = yturb(k,id) - ytb_center + end do + + ! rotate wind farm + deg = config_flags%windfarm_deg + do k = 1, nt + !theta = -30./180.*piconst ! d255: 225 - 255 = -30 + theta = deg/180.*piconst + call coordinate_rotation(x_rot, y_rot, xturb(k,id), yturb(k,id), theta) + xturb(k,id) = x_rot + yturb(k,id) = y_rot + end do + + !!-------------- find ix, iy ----------------- + !igs = int(ide/2.5); jgs = int(jde/2.5) ! set wind farm center grid + igs = int(ide/3); jgs = int(jde/3) ! set wind farm right lower coner + + do i = 1, ide + xgrid(i) = (i-1)*dx + end do + do j = 1, jde + ygrid(j) = (j-1)*dx + end do + + do k = 1, nt + tmp = (igs-1)*dx + xturb(k,id) + do i = 1, ide-1 + if (xgrid(i) <= tmp .and. xgrid(i+1) > tmp) then + ival(k,id) = i + exit + end if + end do + + tmp = (jgs-1)*dx + yturb(k,id) + do j = 1, jde-1 + if (ygrid(j) <= tmp .and. ygrid(j+1) > tmp) then + jval(k,id) = j + exit + end if + end do + + ! ---- test in one cell --- + !ival(k,id) = igs + !jval(k,id) = jgs + !ival(k,id) = 12 + !jval(k,id) = 12 + ! ---- test in one cell --- + end do + !!-------------- end find ix, iy ----------- + write(*,*) 'WRF loc:' + do k = 1, nt + write(*,*) k, ival(k,id), jval(k,id) + end do + end if + end if + + ! + ! read turbine info + ! + if ( wrf_dm_on_monitor() ) then + do k = 1, nt + write(num,*) nkind(k) + num = adjustl(num) + input = "wind-turbine-"//trim(num)//".tbl" + open(file=trim(input),unit=19,form='formatted',status='old') + read(19,*) nval(k) + read(19,*) hubheight(k), diameter(k), stc(k), npower(k) + + area(k)=piconst/4.*diameter(k)**2 + + do i = 1, nval(k) + read(19,*) turbws(k,i), turbtc(k,i), turbpw(k,i) + turbpwcof(k,i) = turbpw(k,i)*1000./(0.5*1.23*turbws(k,i)**3*area(k)) + end do + + radius(k) = 0.5*diameter(k) + radius2(k) = radius(k)**2 + stc2(k) = turbtc(k,nval(k)) + close (19) + end do + end if + + call wrf_dm_bcast_integer(nval,nt) + call wrf_dm_bcast_integer(ival,nt*max_domains) + call wrf_dm_bcast_integer(jval,nt*max_domains) + call wrf_dm_bcast_real(xturb,nt*max_domains) + call wrf_dm_bcast_real(yturb,nt*max_domains) + call wrf_dm_bcast_real(hubheight,nt) + call wrf_dm_bcast_real(area,nt) + call wrf_dm_bcast_real(radius,nt) + call wrf_dm_bcast_real(radius2,nt) + call wrf_dm_bcast_real(diameter,nt) + call wrf_dm_bcast_real(stc,nt) + call wrf_dm_bcast_real(stc2,nt) + call wrf_dm_bcast_real(npower,nt) + call wrf_dm_bcast_integer(nkind,nt) + call wrf_dm_bcast_real(turbws,nt*maxvals) + call wrf_dm_bcast_real(turbtc,nt*maxvals) + call wrf_dm_bcast_real(turbpw,nt*maxvals) + call wrf_dm_bcast_real(turbpwcof,nt*maxvals) + + end subroutine init_module_wind_mav + +#endif +END MODULE module_wind_mav diff --git a/run/README.namelist b/run/README.namelist index c7dc6cdf64..c619814da4 100644 --- a/run/README.namelist +++ b/run/README.namelist @@ -1117,10 +1117,26 @@ Options for MAD-WRF - see doc/README.madwrf for usage information Options for wind turbine drag parameterization: - windfarm_opt (max_dom) = 0 ! 1 = Simulates the effects of wind turbines in the atmospheric evolution + windfarm_opt (max_dom) = 0 ! 1 = Simulates the effects of wind turbines in the atmospheric evolution, A\activates the wind farm parameterization by Fitch et al (2012) + ! 2 = Activate the new wind farm scheme (mav scheme) based on Ma et al. (2022). + This is similar to option 1, but it also considers subgrid-scale wind turbine wake effects windfarm_ij = 0 ! whether to use lat-lon or i-j coordinate as wind turbine locations ! 0 = The coordinate of the turbines are defined in terms of lat-lon ! 1 = The coordinate of the turbines are defined in terms of grid points + ! 2 = Valid only with windfarm_opt=2. The coordinate of the turbines are defined + in terms of lat-lon with the filename of 'windturbines-ll.txt' + windfarm_wake_model = 2 ! Subgrid-scale wind turbine wake model, valid only with windfarm_opt=2, default is 2 + ! 1 = The Jensen model + ! 2 = The XA model + ! 3 = The GM model (windfarm_method is not used) + ! 4 = Jensen and XA ensemble + ! 5 = Jensen, XA and GM ensemble + windfarm_overlap_method = 4 ! Wake superposition method for the Jensen and XA wind turbine wake model, valid only with windfarm_opt=2, default is 4 + ! 1 = linear superposition + ! 2 = squared superposition + ! 3 = modified squared superposition + ! 4 = superposition of the hub-height wind speed (Ma et al. 2022) + windfarm_deg = 0. ! The rotation degree of the wind farm layout. This is valid only when 'windfarm_opt=2' and 'windfarm_ij=1' windfarm_tke_factor = 0.25 ! Correction factor applied to the TKE coefficient (deafault is 0.25, Archer et al. 2020) From 3a504662659672d96ee45867e903fc3a3ad02955 Mon Sep 17 00:00:00 2001 From: weiwangncar Date: Wed, 24 Jan 2024 11:33:45 -0700 Subject: [PATCH 39/41] Use Qv or specific humidity in interpolation if they are available (#1959) TYPE: enhancement KEYWORDS: Qv, specific humidity, vertical interpolation SOURCE: internal DESCRIPTION OF CHANGES: Problem: In current real program, if either water mixing ratio (Qv) or specific humidity (SH) is available, it first converts it to RH, perform vertical interpolation using RH, and then compute Qv for the model input. Assuming Qv and SH are coming from other model's native levels, which tends to be plenty and generally true, it should not be necessary to go through this Qv (SH) to RH, and RH to Qv steps. Solution: Use the flag_qv and flag_sh to avoid using interpolated RH (even though RH is still computed and vertically interpolated). If flag_sh is 1, SH is converted to Qv or mixing ratio. Then Qv is interpolated vertically. A namelist, use_sh_qv, is added for user to choose to do so if SH or Qv data is available. A test case shows that there is some differences in the final Qv in the lower levels (a bit less Qv), particularly near terrain slopes. LIST OF MODIFIED FILES: M Registry/Registry.EM_COMMON M dyn_em/module_initialize_real.F M run/README.namelist TESTS CONDUCTED: - It doesn't affect existing option if RH is the only incoming variable. Tested the code, and it gives bit-for-bit results before and after this change. - The Jenkins tests are all passing. RELEASE NOTE: If water mixing ratio or specific humidity is available in the metgrid output, they can be used directly in vertical interpolation. Previously these fields are first converted to RH, interpolated vertically, and the water vapor mixing ratio is computed at model levels. Now one can use the new namelist, use_sh_qv = T to choose to use SH or Qv data directly. --- Registry/Registry.EM_COMMON | 1 + dyn_em/module_initialize_real.F | 32 ++++++++++++++++++++++++++++++++ run/README.namelist | 3 ++- 3 files changed, 35 insertions(+), 1 deletion(-) diff --git a/Registry/Registry.EM_COMMON b/Registry/Registry.EM_COMMON index 408ce329fd..1ccd75ec32 100644 --- a/Registry/Registry.EM_COMMON +++ b/Registry/Registry.EM_COMMON @@ -2295,6 +2295,7 @@ rconfig integer interp_method_type namelist,domains 1 2 rconfig logical aggregate_lu namelist,domains 1 .false. irh "aggregate_lu" "T/F aggregate the grass, shrubs, trees in LU" rconfig logical rh2qv_wrt_liquid namelist,domains 1 .true. irh "rh2qv_wrt_liquid" "T = rh=>Qv assumes RH wrt liquid water, F = allows ice" rconfig integer rh2qv_method namelist,domains 1 1 irh "rh2qv_method" "1=old MM5 method, 2=new WMO method" +rconfig logical use_sh_qv namelist,domains 1 .false. irh "use_sh_qv" "T/F whether to use SH or mixing ratio in input" rconfig real qv_max_p_safe namelist,domains 1 10000 irh "qv_max_p_safe" "Threshhold pressure, Qv > flag set to value" "Pa" rconfig real qv_max_flag namelist,domains 1 1.E-5 irh "qv_max_flag" "Qv flag for max" "kg kg{-1}" rconfig real qv_max_value namelist,domains 1 3.E-6 irh "qv_max_value" "Qv value for max" "kg kg{-1}" diff --git a/dyn_em/module_initialize_real.F b/dyn_em/module_initialize_real.F index 96629232bf..56ec72aee5 100644 --- a/dyn_em/module_initialize_real.F +++ b/dyn_em/module_initialize_real.F @@ -1181,6 +1181,7 @@ SUBROUTINE init_domain_rk ( grid & END IF ! Some data sets do not provide a 3d geopotential height field. + ! This calculation is more accurate if the data is bottom-up. IF ( grid%ght_gc(i_valid,grid%num_metgrid_levels/2,j_valid) .LT. 1 ) THEN DO j = jts, MIN(jte,jde-1) @@ -1239,6 +1240,15 @@ SUBROUTINE init_domain_rk ( grid & END DO END IF + IF ( flag_sh .EQ. 1 ) THEN + DO j = jts, min(jde-1,jte) + DO i = its, min(ide-1,ite) + IF ( skip_middle_points_t ( ids , ide , jds , jde , i , j , em_width , hold_ups ) ) CYCLE + grid%q2(i,j)=grid%qv_gc(i,1,j) + END DO + END DO + END IF + ! The requested ptop for real data cases. p_top_requested = grid%p_top_requested @@ -1708,6 +1718,23 @@ SUBROUTINE init_domain_rk ( grid & ims , ime , jms , jme , kms , kme , & its , ite , jts , jte , kts , kte ) + ! when specific humidity is available, qv_gc is computed from sh_gc + IF (config_flags%use_sh_qv .and. (flag_sh .eq. 1 .or. flag_qv .eq. 1)) THEN + CALL vert_interp ( grid%qv_gc , grid%pd_gc , moist(:,:,:,P_QV) , grid%pb , & + grid%hgtmaxw , grid%hgttrop , grid%pmaxw , grid%ptrop , & + grid%pmaxwnn , grid%ptropnn , & + 0 , 0 , & + config_flags%maxw_horiz_pres_diff , config_flags%trop_horiz_pres_diff , & + config_flags%maxw_above_this_level , & + num_metgrid_levels , 'Q' , & + interp_type , lagrange_order , extrap_type , & + lowest_lev_from_sfc , use_levels_below_ground , use_surface , & + zap_close_levels , force_sfc_in_vinterp , grid%id , & + ids , ide , jds , jde , kds , kde , & + ims , ime , jms , jme , kms , kme , & + its , ite , jts , jte , kts , kte ) + END IF + ! If this is theta being interpolated, AND we have extra levels for temperature, ! convert those extra levels (trop and max wind) to potential temp. @@ -1778,6 +1805,8 @@ SUBROUTINE init_domain_rk ( grid & its , ite , jts , jte , kts , kte ) END IF + ! do not compute qv from RH if flag_sh or flag_qv = 1, or use_sh_qv = F + IF ( flag_sh .ne. 1 .or. flag_qv .ne. 1 .or. .not. config_flags%use_sh_qv ) THEN IF ( config_flags%rh2qv_method .eq. 1 ) THEN CALL rh_to_mxrat1(grid%u_1, grid%v_1, grid%p , moist(:,:,:,P_QV) , & config_flags%rh2qv_wrt_liquid , & @@ -1799,6 +1828,7 @@ SUBROUTINE init_domain_rk ( grid & ims , ime , jms , jme , kms , kme , & its , ite , jts , jte , kts , kte-1 ) END IF + END IF IF ( .NOT. config_flags%interp_theta ) THEN CALL t_to_theta ( grid%t_2 , grid%p , p00 , & @@ -4042,6 +4072,7 @@ SUBROUTINE init_domain_rk ( grid & ims , ime , jms , jme , kms , kme , & its , ite , jts , jte , kts , kte ) + IF ( flag_sh .ne. 1 .or. flag_qv .ne. 1 .or. .not. config_flags%use_sh_qv ) THEN IF ( config_flags%rh2qv_method .eq. 1 ) THEN CALL rh_to_mxrat1(grid%u_1, grid%v_1, grid%p_hyd , moist(:,:,:,P_QV) , & config_flags%rh2qv_wrt_liquid , & @@ -4063,6 +4094,7 @@ SUBROUTINE init_domain_rk ( grid & ims , ime , jms , jme , kms , kme , & its , ite , jts , jte , kts , kte-1 ) END IF + END IF ! Compute pressure similarly to how computed within model, with final Qv. diff --git a/run/README.namelist b/run/README.namelist index c619814da4..ef95b689a9 100644 --- a/run/README.namelist +++ b/run/README.namelist @@ -251,7 +251,8 @@ Namelist variables specifically for the WPS input for real: rh2qv_method = 1, ! which method to use to computer mixing ratio from RH: default is option 1, the old MM5 method; option 2 uses a WMO recommended method (WMO-No. 49, corrigendum, August 2000) - - there is a difference between the two methods though small + use_sh_qv = .false., ! whether to use specific humidity or mixing ratio data from input + recommended if input data has high vertical resolution interp_theta = .false. ! If set to .false., it will vertically interpolate temperature instead of potential temperature, which may reduce bias when compared with input data From 0c4ed5f7006d4754c44a3a47e43b195c116e491e Mon Sep 17 00:00:00 2001 From: weiwangncar Date: Wed, 24 Jan 2024 12:17:45 -0700 Subject: [PATCH 40/41] add salinity effect in sfclay and sfclayrev (#1963) TYPE: enhancement KEYWORDS: salinity effect, saturation vapor pressure, ocean SOURCE: internal DESCRIPTION OF CHANGES: Problem: The salinity effect of ocean is not considered when computing saturation vapor pressure. Solution: Add the effect in the MM5 and revised MM5 surface layer schemes. The 0.98 factor (set in the code as SALINITY_FACTOR) is an approximation for salinity of 34 part per thousands, and applied for saturation specific humidity. Here the approximation is applied to saturation mixing ratio. The lakemask field is used to exclude this effect from inland lakes. LIST OF MODIFIED FILES: M phys/module_sf_sfclay.F M phys/module_sf_sfclayrev.F M phys/module_surface_driver.F TESTS CONDUCTED: - Tested in many tropical cyclone cases. - The Jenkins tests are all passing. RELEASE NOTE: Add salinity effect in MM5 and revised MM5 surface layer schemes. The effect is lower the saturation vapor pressure over ocean by about 2%. --- phys/module_sf_sfclay.F | 13 +++++++++---- phys/module_sf_sfclayrev.F | 13 +++++++++---- phys/module_surface_driver.F | 22 ++++++++++++---------- 3 files changed, 30 insertions(+), 18 deletions(-) diff --git a/phys/module_sf_sfclay.F b/phys/module_sf_sfclay.F index 8cdaaa158c..03072e82a6 100644 --- a/phys/module_sf_sfclay.F +++ b/phys/module_sf_sfclay.F @@ -20,7 +20,7 @@ SUBROUTINE SFCLAY(U3D,V3D,T3D,QV3D,P3D,dz8w, & GZ1OZ0,WSPD,BR,ISFFLX,DX, & SVP1,SVP2,SVP3,SVPT0,EP1,EP2, & KARMAN,EOMEG,STBOLT, & - P1000mb, & + P1000mb,LAKEMASK, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte, & @@ -136,6 +136,7 @@ SUBROUTINE SFCLAY(U3D,V3D,T3D,QV3D,P3D,dz8w, & INTENT(IN ) :: MAVAIL, & PBLH, & XLAND, & + LAKEMASK, & TSK REAL, DIMENSION( ims:ime, jms:jme ) , & @@ -242,7 +243,7 @@ SUBROUTINE SFCLAY(U3D,V3D,T3D,QV3D,P3D,dz8w, & QSFC(ims,j),LH(ims,j), & GZ1OZ0(ims,j),WSPD(ims,j),BR(ims,j),ISFFLX,DX2D, & SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN,EOMEG,STBOLT, & - P1000mb, & + P1000mb,LAKEMASK(ims,j), & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte & @@ -267,7 +268,7 @@ SUBROUTINE SFCLAY1D(J,UX,VX,T1D,QV1D,P1D,dz8w1d, & QSFC,LH,GZ1OZ0,WSPD,BR,ISFFLX,DX, & SVP1,SVP2,SVP3,SVPT0,EP1,EP2, & KARMAN,EOMEG,STBOLT, & - P1000mb, & + P1000mb,LAKEMASK, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte, & @@ -278,6 +279,7 @@ SUBROUTINE SFCLAY1D(J,UX,VX,T1D,QV1D,P1D,dz8w1d, & !------------------------------------------------------------------- REAL, PARAMETER :: XKA=2.4E-5 REAL, PARAMETER :: PRT=1. + REAL, PARAMETER :: SALINITY_FACTOR=0.98 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & @@ -294,6 +296,7 @@ SUBROUTINE SFCLAY1D(J,UX,VX,T1D,QV1D,P1D,dz8w1d, & INTENT(IN ) :: MAVAIL, & PBLH, & XLAND, & + LAKEMASK, & TSK ! REAL, DIMENSION( ims:ime ) , & @@ -452,7 +455,9 @@ SUBROUTINE SFCLAY1D(J,UX,VX,T1D,QV1D,P1D,dz8w1d, & DO 60 I=its,ite E1=SVP1*EXP(SVP2*(TGDSA(I)-SVPT0)/(TGDSA(I)-SVP3)) ! for land points QSFC can come from previous time step - if(xland(i).gt.1.5.or.qsfc(i).le.0.0)QSFC(I)=EP2*E1/(PSFC(I)-E1) +! the saturation vapor pressure for salty water is on average 2% lower + if(xland(i).gt.1.5 .and. lakemask(i).eq.0.) E1=E1*SALINITY_FACTOR + if(xland(i).gt.1.5.or.qsfc(i).le.0.0)QSFC(I)=EP2*E1/(PSFC(I)-E1) ! QGH CHANGED TO USE LOWEST-LEVEL AIR TEMP CONSISTENT WITH MYJSFC CHANGE ! Q2SAT = QGH IN LSM E1=SVP1*EXP(SVP2*(T1D(I)-SVPT0)/(T1D(I)-SVP3)) diff --git a/phys/module_sf_sfclayrev.F b/phys/module_sf_sfclayrev.F index 2a3ca5a01d..48642fa866 100644 --- a/phys/module_sf_sfclayrev.F +++ b/phys/module_sf_sfclayrev.F @@ -20,7 +20,7 @@ SUBROUTINE SFCLAYREV(U3D,V3D,T3D,QV3D,P3D,dz8w, & GZ1OZ0,WSPD,BR,ISFFLX,DX, & SVP1,SVP2,SVP3,SVPT0,EP1,EP2, & KARMAN,EOMEG,STBOLT, & - P1000mb, & + P1000mb,LAKEMASK, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte, & @@ -137,6 +137,7 @@ SUBROUTINE SFCLAYREV(U3D,V3D,T3D,QV3D,P3D,dz8w, & INTENT(IN ) :: MAVAIL, & PBLH, & XLAND, & + LAKEMASK, & TSK REAL, DIMENSION( ims:ime, jms:jme ) , & INTENT(OUT ) :: U10, & @@ -235,7 +236,7 @@ SUBROUTINE SFCLAYREV(U3D,V3D,T3D,QV3D,P3D,dz8w, & QSFC(ims,j),LH(ims,j), & GZ1OZ0(ims,j),WSPD(ims,j),BR(ims,j),ISFFLX,DX, & SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN,EOMEG,STBOLT, & - P1000mb, & + P1000mb,LAKEMASK(ims,j), & shalwater_z0,water_depth(ims,j),shalwater_depth, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & @@ -261,7 +262,7 @@ SUBROUTINE SFCLAYREV1D(J,UX,VX,T1D,QV1D,P1D,dz8w1d, & QSFC,LH,GZ1OZ0,WSPD,BR,ISFFLX,DX, & SVP1,SVP2,SVP3,SVPT0,EP1,EP2, & KARMAN,EOMEG,STBOLT, & - P1000mb, & + P1000mb,LAKEMASK, & shalwater_z0,water_depth,shalwater_depth, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & @@ -273,6 +274,7 @@ SUBROUTINE SFCLAYREV1D(J,UX,VX,T1D,QV1D,P1D,dz8w1d, & !------------------------------------------------------------------- REAL, PARAMETER :: XKA=2.4E-5 REAL, PARAMETER :: PRT=1. + REAL, PARAMETER :: SALINITY_FACTOR=0.98 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & @@ -289,6 +291,7 @@ SUBROUTINE SFCLAYREV1D(J,UX,VX,T1D,QV1D,P1D,dz8w1d, & INTENT(IN ) :: MAVAIL, & PBLH, & XLAND, & + LAKEMASK, & TSK ! REAL, DIMENSION( ims:ime ) , & @@ -459,7 +462,9 @@ SUBROUTINE SFCLAYREV1D(J,UX,VX,T1D,QV1D,P1D,dz8w1d, & DO 60 I=its,ite E1=SVP1*EXP(SVP2*(TGDSA(I)-SVPT0)/(TGDSA(I)-SVP3)) ! for land points QSFC can come from previous time step - if(xland(i).gt.1.5.or.qsfc(i).le.0.0)QSFC(I)=EP2*E1/(PSFC(I)-E1) +! the saturation vapor pressure for salty water is on average 2% lower + if(xland(i).gt.1.5 .and. lakemask(i).eq.0.) E1=E1*SALINITY_FACTOR + if(xland(i).gt.1.5.or.qsfc(i).le.0.0)QSFC(I)=EP2*E1/(PSFC(I)-E1) ! QGH CHANGED TO USE LOWEST-LEVEL AIR TEMP CONSISTENT WITH MYJSFC CHANGE ! Q2SAT = QGH IN LSM E1=SVP1*EXP(SVP2*(T1D(I)-SVPT0)/(T1D(I)-SVP3)) diff --git a/phys/module_surface_driver.F b/phys/module_surface_driver.F index f1592a1f00..c766b83b80 100644 --- a/phys/module_surface_driver.F +++ b/phys/module_surface_driver.F @@ -2039,7 +2039,7 @@ SUBROUTINE surface_driver( & u10,v10,th2,t2,q2, & gz1oz0,wspd,br,isfflx,dx2d, & svp1,svp2,svp3,svpt0,ep_1,ep_2,karman,eomeg,stbolt, & - P1000mb, & + P1000mb,lakemask, & XICE,SST,TSK_SEA, & CHS2_SEA,CHS_SEA,CPM_SEA,CQS2_SEA,FLHC_SEA,FLQC_SEA, & HFX_SEA,LH_SEA,QFX_SEA,QGH_SEA,QSFC_SEA,ZNT_SEA, & @@ -2057,7 +2057,7 @@ SUBROUTINE surface_driver( & u10,v10,th2,t2,q2, & gz1oz0,wspd,br,isfflx,dx2d, & svp1,svp2,svp3,svpt0,ep_1,ep_2,karman,eomeg,stbolt, & - P1000mb, & + P1000mb,lakemask, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte, & @@ -2092,7 +2092,7 @@ SUBROUTINE surface_driver( & u10,v10,th2,t2,q2, & gz1oz0,wspd,br,isfflx,dx, & svp1,svp2,svp3,svpt0,ep_1,ep_2,karman,eomeg,stbolt, & - P1000mb, & + P1000mb,lakemask, & XICE,SST,TSK_SEA, & CHS2_SEA,CHS_SEA,CPM_SEA,CQS2_SEA,FLHC_SEA,FLQC_SEA, & HFX_SEA,LH_SEA,QFX_SEA,QGH_SEA,QSFC_SEA,ZNT_SEA, & @@ -2111,7 +2111,7 @@ SUBROUTINE surface_driver( & u10,v10,th2,t2,q2, & gz1oz0,wspd,br,isfflx,dx, & svp1,svp2,svp3,svpt0,ep_1,ep_2,karman,eomeg,stbolt, & - P1000mb, & + P1000mb,lakemask, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte, & @@ -5799,7 +5799,7 @@ SUBROUTINE sfclayrev_seaice_wrapper(U3D,V3D,T3D,QV3D,P3D,dz8w, & GZ1OZ0,WSPD,BR,ISFFLX,DX, & SVP1,SVP2,SVP3,SVPT0,EP1,EP2, & KARMAN,EOMEG,STBOLT, & - P1000, & + P1000,LAKEMASK, & XICE,SST,TSK_SEA, & CHS2_SEA,CHS_SEA,CPM_SEA,CQS2_SEA,FLHC_SEA,FLQC_SEA, & HFX_SEA,LH_SEA,QFX_SEA,QGH_SEA,QSFC_SEA,ZNT_SEA, & @@ -5835,6 +5835,7 @@ SUBROUTINE sfclayrev_seaice_wrapper(U3D,V3D,T3D,QV3D,P3D,dz8w, & INTENT(IN ) :: MAVAIL, & PBLH, & XLAND, & + LAKEMASK, & TSK REAL, DIMENSION( ims:ime, jms:jme ) , & INTENT(OUT ) :: U10, & @@ -6061,7 +6062,7 @@ SUBROUTINE sfclayrev_seaice_wrapper(U3D,V3D,T3D,QV3D,P3D,dz8w, & GZ1OZ0,WSPD,BR,ISFFLX,DX, & SVP1,SVP2,SVP3,SVPT0,EP1,EP2, & KARMAN,EOMEG,STBOLT, & - P1000, & + P1000,lakemask, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte, & @@ -6155,7 +6156,7 @@ SUBROUTINE sfclayrev_seaice_wrapper(U3D,V3D,T3D,QV3D,P3D,dz8w, & ISFFLX,DX, & SVP1,SVP2,SVP3,SVPT0,EP1,EP2, & KARMAN,EOMEG,STBOLT, & - P1000, & + P1000,lakemask, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte, & ! 0 @@ -6230,7 +6231,7 @@ SUBROUTINE sfclay_seaice_wrapper(U3D,V3D,T3D,QV3D,P3D,dz8w, & GZ1OZ0,WSPD,BR,ISFFLX,DX, & SVP1,SVP2,SVP3,SVPT0,EP1,EP2, & KARMAN,EOMEG,STBOLT, & - P1000, & + P1000,lakemask, & XICE,SST,TSK_SEA, & CHS2_SEA,CHS_SEA,CPM_SEA,CQS2_SEA,FLHC_SEA,FLQC_SEA, & HFX_SEA,LH_SEA,QFX_SEA,QGH_SEA,QSFC_SEA,ZNT_SEA, & @@ -6265,6 +6266,7 @@ SUBROUTINE sfclay_seaice_wrapper(U3D,V3D,T3D,QV3D,P3D,dz8w, & INTENT(IN ) :: MAVAIL, & PBLH, & XLAND, & + LAKEMASK, & TSK REAL, DIMENSION( ims:ime, jms:jme ) , & INTENT(OUT ) :: U10, & @@ -6491,7 +6493,7 @@ SUBROUTINE sfclay_seaice_wrapper(U3D,V3D,T3D,QV3D,P3D,dz8w, & GZ1OZ0,WSPD,BR,ISFFLX,DX, & SVP1,SVP2,SVP3,SVPT0,EP1,EP2, & KARMAN,EOMEG,STBOLT, & - P1000, & + P1000,lakemask, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte, & @@ -6585,7 +6587,7 @@ SUBROUTINE sfclay_seaice_wrapper(U3D,V3D,T3D,QV3D,P3D,dz8w, & ISFFLX,DX, & SVP1,SVP2,SVP3,SVPT0,EP1,EP2, & KARMAN,EOMEG,STBOLT, & - P1000, & + P1000,lakemask, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte, & ! 0 From 240c6f3faee93aff9eaf9995e9cb2f185f8f273c Mon Sep 17 00:00:00 2001 From: Anthony Islas <128631809+islas@users.noreply.github.com> Date: Thu, 25 Jan 2024 01:02:32 +0000 Subject: [PATCH 41/41] Rectify many of the missing dependencies (#1950) TYPE: bug fix KEYWORDS: make, dependencies SOURCE: internal DESCRIPTION OF CHANGES: Problem: Occasionally and non-deterministically the WRF make compilation will fail due to erroneous depend rules or missing rules which result in essentially either (1) race conditions relying on modules to just happen to be compiled in time for use (2) when rules are followed, subsequent dependencies are missing and compilation fails or (3) complete recompilation of certain files. For instance, if one takes a look at a build log, one could see that module_mp_thompson.o is compiled twice - once as module_mp_thompson.o and again as ../phys/module_mp_thompson.o. This is not or rarely observed in the current regression tests because compilation is done three times as a stop-gap to avoid this issue. Solution: Add missing dependencies and fix malformed dependencies. LIST OF MODIFIED FILES: M main/depend.common TESTS CONDUCTED: - Cannot be observed in current regression tests as they are designed to obscure this very issue. Can be observed with many single individual compilations. - It passed the regression tests. RELEASE NOTE: Fix missing or erroneous dependencies in make rules. --- main/depend.common | 3737 ++++++++++++++++++++++++++++++-------------- 1 file changed, 2604 insertions(+), 1133 deletions(-) diff --git a/main/depend.common b/main/depend.common index 65ee00c3b3..5bcdc1720a 100644 --- a/main/depend.common +++ b/main/depend.common @@ -1,1336 +1,2807 @@ # DEPENDENCIES for frame - module_configure.o: \ - ../dyn_em/namelist_remappings_em.h \ - module_domain_type.o \ - module_state_description.o \ - module_wrf_error.o \ - module_driver_constants.o - -module_dm.o: module_machine.o module_state_description.o module_wrf_error.o \ - module_domain.o \ - module_driver_constants.o \ - module_timing.o \ - module_comm_nesting_dm.o \ - module_configure.o module_comm_dm.o \ - module_cpl.o \ - ../share/module_model_constants.o - -module_timing.o: hires_timer.o clog.o - -module_comm_dm.o: module_comm_dm_0.o module_comm_dm_1.o module_comm_dm_2.o module_comm_dm_3.o module_comm_dm_4.o - -module_comm_dm_0.o: module_domain.o module_configure.o -module_comm_dm_1.o: module_domain.o module_configure.o -module_comm_dm_2.o: module_domain.o module_configure.o -module_comm_dm_3.o: module_domain.o module_configure.o -module_comm_dm_4.o: module_domain.o module_configure.o + ../dyn_em/namelist_remappings_em.h \ + module_domain_type.o \ + module_state_description.o \ + module_wrf_error.o \ + module_driver_constants.o + + +module_dm.o: \ + module_machine.o \ + module_state_description.o \ + module_wrf_error.o \ + module_domain.o \ + module_driver_constants.o \ + module_timing.o \ + module_comm_nesting_dm.o \ + module_configure.o \ + module_comm_dm.o \ + module_cpl.o \ + ../share/module_model_constants.o + + +module_timing.o: \ + module_wrf_error.o \ + hires_timer.o \ + clog.o + + +module_comm_dm.o: \ + module_configure.o \ + module_domain.o \ + module_driver_constants.o \ + module_comm_dm_0.o \ + module_comm_dm_1.o \ + module_comm_dm_2.o \ + module_comm_dm_3.o \ + module_comm_dm_4.o + + +module_comm_dm_0.o: \ + module_driver_constants.o \ + module_domain.o \ + module_configure.o + + +module_comm_dm_1.o: \ + module_driver_constants.o \ + module_domain.o \ + module_configure.o + + +module_comm_dm_2.o: \ + module_driver_constants.o \ + module_domain.o \ + module_configure.o + + +module_comm_dm_3.o: \ + module_driver_constants.o \ + module_domain.o \ + module_configure.o + + +module_comm_dm_4.o: \ + module_driver_constants.o \ + module_domain.o \ + module_configure.o + module_comm_nesting_dm.o: \ - module_domain.o \ - module_configure.o - -module_dm_stubs.F: module_domain.o - -module_domain.o: module_domain_type.o \ - module_alloc_space_0.o \ - module_alloc_space_1.o \ - module_alloc_space_2.o \ - module_alloc_space_3.o \ - module_alloc_space_4.o \ - module_alloc_space_5.o \ - module_alloc_space_6.o \ - module_alloc_space_7.o \ - module_alloc_space_8.o \ - module_alloc_space_9.o \ - module_driver_constants.o \ - module_configure.o \ - module_machine.o \ - module_state_description.o \ - module_wrf_error.o \ - $(ESMF_MOD_DEPENDENCE) - -module_domain_type.o : module_driver_constants.o module_streams.o $(ESMF_MOD_DEPENDENCE) - -module_alloc_space_0.o : module_domain_type.o module_configure.o -module_alloc_space_1.o : module_domain_type.o module_configure.o -module_alloc_space_2.o : module_domain_type.o module_configure.o -module_alloc_space_3.o : module_domain_type.o module_configure.o -module_alloc_space_4.o : module_domain_type.o module_configure.o -module_alloc_space_5.o : module_domain_type.o module_configure.o -module_alloc_space_6.o : module_domain_type.o module_configure.o -module_alloc_space_7.o : module_domain_type.o module_configure.o -module_alloc_space_8.o : module_domain_type.o module_configure.o -module_alloc_space_9.o : module_domain_type.o module_configure.o - -module_streams.o : \ - module_state_description.o + module_driver_constants.o \ + module_domain.o \ + module_configure.o + + +module_dm_stubs.F: \ + module_domain.o + + +module_domain.o: \ + module_domain_type.o \ + module_alloc_space_0.o \ + module_alloc_space_1.o \ + module_alloc_space_2.o \ + module_alloc_space_3.o \ + module_alloc_space_4.o \ + module_alloc_space_5.o \ + module_alloc_space_6.o \ + module_alloc_space_7.o \ + module_alloc_space_8.o \ + module_alloc_space_9.o \ + module_driver_constants.o \ + module_configure.o \ + module_machine.o \ + module_state_description.o \ + module_wrf_error.o \ + $(ESMF_MOD_DEPENDENCE) + + +module_domain_type.o: \ + module_driver_constants.o \ + module_streams.o \ + $(ESMF_MOD_DEPENDENCE) + + +module_alloc_space_0.o: \ + module_domain_type.o \ + module_configure.o + + +module_alloc_space_1.o: \ + module_domain_type.o \ + module_configure.o + + +module_alloc_space_2.o: \ + module_domain_type.o \ + module_configure.o + + +module_alloc_space_3.o: \ + module_domain_type.o \ + module_configure.o + + +module_alloc_space_4.o: \ + module_domain_type.o \ + module_configure.o + + +module_alloc_space_5.o: \ + module_domain_type.o \ + module_configure.o + + +module_alloc_space_6.o: \ + module_domain_type.o \ + module_configure.o + + +module_alloc_space_7.o: \ + module_domain_type.o \ + module_configure.o + + +module_alloc_space_8.o: \ + module_domain_type.o \ + module_configure.o + + +module_alloc_space_9.o: \ + module_domain_type.o \ + module_configure.o + + +module_streams.o: \ + module_state_description.o + module_driver_constants.o: \ - module_state_description.o \ - module_wrf_error.o + module_state_description.o \ + module_wrf_error.o + module_integrate.o: \ - module_domain.o \ - module_timing.o \ - module_driver_constants.o \ - module_state_description.o \ - module_nesting.o \ - module_configure.o \ - $(LLIST) \ - module_cpl.o \ - module_dm.o \ - $(ESMF_MOD_DEPENDENCE) + module_domain.o \ + module_timing.o \ + module_driver_constants.o \ + module_state_description.o \ + module_nesting.o \ + module_configure.o \ + $(LLIST) \ + module_cpl.o \ + module_dm.o \ + $(ESMF_MOD_DEPENDENCE) + module_intermediate_nmm.o: \ - module_state_description.o \ - module_domain.o \ - module_configure.o \ - module_dm.o \ - module_comm_dm.o \ - module_timing.o - -module_io.o : md_calls.inc \ - module_dm.o \ - module_state_description.o \ - module_configure.o \ - module_streams.o \ - module_driver_constants.o + module_state_description.o \ + module_domain.o \ + module_configure.o \ + module_dm.o \ + module_comm_dm.o \ + module_timing.o + + +module_io.o: \ + module_domain.o \ + md_calls.inc \ + module_dm.o \ + module_state_description.o \ + module_configure.o \ + module_streams.o \ + module_driver_constants.o + module_io_quilt.o: \ - module_state_description.o \ - module_dm.o \ - module_configure.o \ - module_internal_header_util.o \ - module_quilt_outbuf_ops.o \ - module_wrf_error.o \ - module_cpl.o + module_state_description.o \ + module_dm.o \ + module_configure.o \ + module_internal_header_util.o \ + module_quilt_outbuf_ops.o \ + module_wrf_error.o \ + module_cpl.o + module_machine.o: \ - module_driver_constants.o + module_driver_constants.o + module_nesting.o: \ - module_machine.o \ - module_driver_constants.o \ - module_configure.o \ - $(ESMF_MOD_DEPENDENCE) \ - module_domain.o + module_machine.o \ + module_driver_constants.o \ + module_configure.o \ + $(ESMF_MOD_DEPENDENCE) \ + module_domain.o + module_quilt_outbuf_ops.o: \ - module_state_description.o module_timing.o - -module_tiles.o: module_domain.o \ - module_driver_constants.o \ - module_machine.o \ - module_configure.o \ - module_wrf_error.o - + module_state_description.o \ + module_timing.o + + +module_tiles.o: \ + module_domain.o \ + module_driver_constants.o \ + module_machine.o \ + module_configure.o \ + module_wrf_error.o + + module_timing.o: \ - module_state_description.o \ - module_wrf_error.o + module_state_description.o \ + module_wrf_error.o + module_wrf_error.o: \ - wrf_shutdown.o \ - clog.o \ - $(ESMF_MOD_DEPENDENCE) + wrf_shutdown.o \ + clog.o \ + $(ESMF_MOD_DEPENDENCE) + wrf_debug.o: \ - module_wrf_error.o + module_wrf_error.o + + +module_sm.o: \ + module_wrf_error.o -module_sm.o: module_wrf_error.o module_cpl.o: \ - ../share/module_model_constants.o \ - module_driver_constants.o \ - module_domain.o \ - module_configure.o \ - module_cpl_oasis3.o + ../share/module_model_constants.o \ + module_driver_constants.o \ + module_domain.o \ + module_configure.o \ + module_cpl_oasis3.o + -module_cpl_oasis3.o: module_driver_constants.o \ - module_domain.o +module_cpl_oasis3.o: \ + module_driver_constants.o \ + module_domain.o -module_clear_halos.o: module_configure.o \ - module_domain.o + +module_clear_halos.o: \ + module_configure.o \ + module_domain.o \ # End of DEPENDENCIES for frame # DEPENDENCIES for phys -module_madwrf.o: ../share/module_model_constants.o \ - ../share/module_soil_pre.o \ - ../phys/module_mp_thompson.o +module_madwrf.o: \ + module_wrf_top.o \ + ../share/module_model_constants.o \ + ../share/module_soil_pre.o \ + module_mp_thompson.o -module_bl_myjpbl.o: ../share/module_model_constants.o -module_bl_myjurb.o: ../share/module_model_constants.o +module_bl_myjpbl.o: \ + ../share/module_model_constants.o -module_bl_gbmpbl.o: ../share/module_model_constants.o -module_bl_boulac.o: ../share/module_model_constants.o +module_bl_myjurb.o: \ + ../share/module_model_constants.o -module_bl_qnsepbl.o: ../share/module_model_constants.o -module_progtm.o: module_gfs_machine.o +module_bl_gbmpbl.o: \ + ../share/module_model_constants.o -module_bl_gfs.o: module_gfs_machine.o \ - module_gfs_physcons.o -module_bl_gfsedmf.o: module_gfs_machine.o \ - module_gfs_physcons.o +module_bl_boulac.o: \ + ../share/module_model_constants.o -module_bl_mynn_common.o: ccpp_kind_types.o -module_bl_mynn.o: module_bl_mynn_common.o +module_bl_qnsepbl.o: \ + ../share/module_model_constants.o -module_bl_mynn_wrapper.o: module_bl_mynn.o \ - module_bl_mynn_common.o -module_cam_upper_bc.o: module_cam_shr_kind_mod.o \ - module_cam_support.o +module_progtm.o: \ + module_gfs_machine.o -module_cam_constituents.o: module_cam_shr_kind_mod.o \ - module_cam_physconst.o \ - module_cam_support.o \ - ../frame/module_wrf_error.o -module_cam_trb_mtn_stress.o: module_cam_shr_kind_mod.o \ - module_cam_support.o +module_bl_gfs.o: \ + module_gfs_machine.o \ + module_gfs_physcons.o -module_cam_molec_diff.o: module_cam_support.o \ - module_cam_constituents.o \ - module_cam_upper_bc.o -module_data_cam_mam_aero.o : module_cam_shr_kind_mod.o \ - module_cam_support.o \ - module_cam_mp_radconstants.o +module_bl_gfsedmf.o: \ + module_gfs_machine.o \ + module_gfs_physcons.o -module_data_cam_mam_asect.o : module_cam_shr_kind_mod.o \ - module_data_cam_mam_aero.o -module_cam_bl_diffusion_solver.o: module_cam_support.o +module_bl_mynn.o: \ + module_bl_mynn_common.o -module_cam_bl_eddy_diff.o:module_cam_bl_diffusion_solver.o \ - module_cam_support.o -module_bl_camuwpbl_driver.o: module_cam_shr_kind_mod.o \ - module_cam_support.o \ - module_cam_constituents.o \ - module_cam_bl_diffusion_solver.o\ - module_cam_physconst.o \ - module_cam_trb_mtn_stress.o \ - module_cam_bl_eddy_diff.o \ - module_cam_wv_saturation.o \ - module_cam_molec_diff.o \ - module_data_cam_mam_aero.o \ - ../share/module_model_constants.o \ - module_cam_esinti.o +module_bl_mynn_wrapper.o: \ + module_bl_mynn.o \ + module_bl_mynn_common.o -module_sf_mynn.o: module_sf_sfclay.o module_bl_mynn.o \ - ../share/module_model_constants.o \ - ../frame/module_wrf_error.o -module_sf_fogdes.o: ../share/module_model_constants.o +module_cam_upper_bc.o: \ + module_cam_shr_kind_mod.o \ + module_cam_support.o -module_bl_fogdes.o: ../share/module_model_constants.o -module_sf_gfdl.o : \ - module_gfs_machine.o \ - module_sf_exchcoef.o \ - module_gfs_funcphys.o \ - module_gfs_physcons.o +module_cam_constituents.o: \ + module_cam_shr_kind_mod.o \ + module_cam_physconst.o \ + module_cam_support.o \ + ../frame/module_wrf_error.o -module_cu_bmj.o: ../share/module_model_constants.o -module_shcu_camuwshcu_driver.o: module_cam_support.o \ - module_mp_cammgmp_driver.o \ - module_cam_physconst.o \ - module_cam_wv_saturation.o \ - module_shcu_camuwshcu.o +module_cam_trb_mtn_stress.o: \ + module_cam_shr_kind_mod.o \ + module_cam_support.o -module_shcu_camuwshcu.o: module_cam_support.o \ - module_cam_constituents.o \ - module_cam_error_function.o \ - module_cam_esinti.o \ - module_cam_physconst.o \ - module_bl_camuwpbl_driver.o -module_shcu_deng.o: +module_cam_molec_diff.o: \ + module_cam_support.o \ + module_cam_constituents.o \ + module_cam_upper_bc.o -module_cu_camzm_driver.o: ../share/module_model_constants.o \ - module_cam_shr_kind_mod.o \ - module_cam_support.o \ - module_cam_physconst.o \ - module_mp_cammgmp_driver.o \ - module_bl_camuwpbl_driver.o \ - module_cu_camzm.o -module_cu_camzm.o: module_cam_shr_kind_mod.o \ - module_cam_constituents.o \ - module_cam_support.o \ - module_cam_physconst.o \ - module_cam_wv_saturation.o \ - module_cam_cldwat.o +module_data_cam_mam_aero.o: \ + module_cam_shr_kind_mod.o \ + module_cam_support.o \ + module_cam_mp_radconstants.o -module_cam_error_function.o: -module_cam_cldwat.o: module_cam_shr_kind_mod.o \ - module_cam_support.o \ - module_cam_wv_saturation.o \ - module_cam_physconst.o +module_data_cam_mam_asect.o: \ + module_cam_shr_kind_mod.o \ + module_data_cam_mam_aero.o -module_cam_esinti.o: module_cam_shr_kind_mod.o \ - module_cam_wv_saturation.o -module_cam_wv_saturation.o: module_cam_shr_kind_mod.o \ - module_cam_support.o \ - module_cam_gffgch.o +module_cam_bl_diffusion_solver.o: \ + module_cam_support.o -module_cam_gffgch.o: module_cam_shr_kind_mod.o \ - module_cam_support.o \ - module_cam_physconst.o -module_cam_physconst.o: module_cam_shr_kind_mod.o \ - module_cam_shr_const_mod.o +module_cam_bl_eddy_diff.o: \ + module_cam_bl_diffusion_solver.o \ + module_cam_support.o -module_cam_shr_const_mod.o: module_cam_shr_kind_mod.o -module_cam_support.o: module_cam_shr_kind_mod.o \ - ../frame/module_state_description.o +module_bl_camuwpbl_driver.o: \ + module_cam_shr_kind_mod.o \ + module_cam_support.o \ + module_cam_constituents.o \ + module_cam_bl_diffusion_solver.o \ + module_cam_physconst.o \ + module_cam_trb_mtn_stress.o \ + module_cam_bl_eddy_diff.o \ + module_cam_wv_saturation.o \ + module_cam_molec_diff.o \ + module_data_cam_mam_aero.o \ + ../share/module_model_constants.o \ + module_cam_esinti.o -module_cam_shr_kind_mod.o: -module_cu_kf.o: ../frame/module_wrf_error.o +module_sf_mynn.o: \ + module_sf_sfclay.o \ + module_bl_mynn.o \ + ../share/module_model_constants.o \ + ../frame/module_wrf_error.o -module_cu_kfcup.o: ../frame/module_wrf_error.o \ - ../frame/module_state_description.o \ - $(CF2) \ - ../share/module_model_constants.o \ - module_mixactivate.o - -module_cu_kfeta.o: ../frame/module_wrf_error.o - -module_cu_gd.o: - -module_cu_ksas.o: - -module_cu_nsas.o: - -module_cu_du.o: ../frame/module_wrf_error.o - -module_gfs_physcons.o: module_gfs_machine.o +module_sf_fogdes.o: \ + ../share/module_model_constants.o -module_gfs_funcphys.o: module_gfs_machine.o \ - module_gfs_physcons.o -module_cu_sas.o: module_gfs_machine.o \ - module_gfs_funcphys.o \ - module_gfs_physcons.o -module_cu_scalesas.o: module_gfs_machine.o \ - module_gfs_funcphys.o \ - module_gfs_physcons.o +module_bl_fogdes.o: \ + ../share/module_model_constants.o -module_cu_osas.o: module_gfs_machine.o \ - module_gfs_funcphys.o \ - module_gfs_physcons.o -module_cu_tiedtke.o:module_gfs_machine.o \ - module_gfs_funcphys.o \ - module_gfs_physcons.o +module_sf_gfdl.o: \ + module_gfs_machine.o \ + module_sf_exchcoef.o \ + module_gfs_funcphys.o \ + module_gfs_physcons.o -module_cu_ntiedtke.o: ../share/module_model_constants.o -module_ra_gfdleta.o: ../frame/module_dm.o \ - module_mp_etanew.o +module_cu_bmj.o: \ + ../share/module_model_constants.o -module_ra_rrtm.o: ../frame/module_wrf_error.o \ - module_ra_clWRF_support.o \ - ../frame/module_dm.o -module_ra_cam_support.o: module_cam_support.o \ - ../frame/module_wrf_error.o +module_shcu_camuwshcu_driver.o: \ + module_data_cam_mam_asect.o \ + module_cam_support.o \ + module_mp_cammgmp_driver.o \ + module_cam_physconst.o \ + module_cam_wv_saturation.o \ + module_shcu_camuwshcu.o -module_ra_cam.o: module_ra_cam_support.o \ - module_cam_support.o \ - module_ra_clWRF_support.o \ - ../frame/module_wrf_error.o -module_mp_lin.o : ../frame/module_wrf_error.o \ - module_mp_radar.o +module_shcu_camuwshcu.o: \ + module_cam_support.o \ + module_cam_constituents.o \ + module_cam_error_function.o \ + module_cam_esinti.o \ + module_cam_physconst.o \ + module_bl_camuwpbl_driver.o -module_ra_flg.o: ../frame/module_wrf_error.o \ - ../frame/module_dm.o -module_mp_sbu_ylin.o : ../frame/module_wrf_error.o \ - ../share/module_model_constants.o +module_shcu_deng.o: \ + ../frame/module_wrf_error.o -module_mp_milbrandt2mom.o : ../frame/module_wrf_error.o \ - ../share/module_model_constants.o -module_mp_thompson.o : ../frame/module_wrf_error.o \ - module_mp_radar.o +module_cu_camzm_driver.o: \ + module_data_cam_mam_asect.o \ + ../share/module_model_constants.o \ + module_cam_shr_kind_mod.o \ + module_cam_support.o \ + module_cam_physconst.o \ + module_mp_cammgmp_driver.o \ + module_bl_camuwpbl_driver.o \ + module_cu_camzm.o -module_mp_nssl_2mom.o : ../frame/module_wrf_error.o \ - ../share/module_model_constants.o -module_mp_fast_sbm.o : module_mp_radar.o +module_cu_camzm.o: \ + module_cam_shr_kind_mod.o \ + module_cam_constituents.o \ + module_cam_support.o \ + module_cam_physconst.o \ + module_cam_wv_saturation.o \ + module_cam_cldwat.o -module_mp_full_sbm.o : module_mp_radar.o -module_mp_cammgmp_driver.o : module_cam_mp_microp_aero.o \ - module_cam_constituents.o \ - module_cam_shr_kind_mod.o \ - module_cam_cldwat.o \ - module_cam_mp_cldwat2m_micro.o \ - module_cam_physconst.o \ - module_cam_support.o \ - module_data_cam_mam_aero.o \ - module_data_cam_mam_asect.o \ - module_cam_wv_saturation.o \ - module_cam_mp_ndrop.o \ - module_cam_mp_conv_water.o \ - ../frame/module_state_description.o +module_cam_error_function.o: \ -module_cam_mp_microp_aero.o : module_cam_shr_kind_mod.o \ - module_cam_support.o \ - module_cam_physconst.o \ - module_cam_error_function.o \ - module_cam_wv_saturation.o \ - module_cam_mp_ndrop.o \ - module_data_cam_mam_aero.o -module_cam_mp_cldwat2m_micro.o : module_cam_shr_kind_mod.o \ - module_cam_support.o \ - module_cam_physconst.o \ - module_cam_error_function.o \ - module_cam_wv_saturation.o -module_cam_mp_ndrop.o : module_cam_shr_kind_mod.o \ - module_data_cam_mam_aero.o \ - module_cam_support.o \ - module_cam_physconst.o \ - module_cam_constituents.o \ - module_cam_error_function.o \ - module_cam_wv_saturation.o +module_cam_cldwat.o: \ + module_cam_shr_kind_mod.o \ + module_cam_support.o \ + module_cam_wv_saturation.o \ + module_cam_physconst.o -module_cam_mp_modal_aero_initialize_data_phys.o : module_data_cam_mam_aero.o -module_cam_mp_conv_water.o: module_cam_shr_kind_mod.o \ - module_cam_support.o \ - module_cam_physconst.o -module_cam_mp_qneg3.o: module_cam_shr_kind_mod.o \ - module_cam_support.o +module_cam_esinti.o: \ + module_cam_shr_kind_mod.o \ + module_cam_wv_saturation.o -module_cam_mp_radconstants.o : module_cam_shr_kind_mod.o \ - module_cam_support.o -module_cam_infnan.o: module_cam_shr_kind_mod.o -module_mp_gsfcgce.o : ../frame/module_wrf_error.o \ - module_mp_radar.o +module_cam_wv_saturation.o: \ + ../frame/module_wrf_error.o \ + module_cam_shr_kind_mod.o \ + module_cam_support.o \ + module_cam_gffgch.o -module_sf_myjsfc.o: ../share/module_model_constants.o -module_sf_qnsesfc.o: ../share/module_model_constants.o +module_cam_gffgch.o: \ + module_cam_shr_kind_mod.o \ + module_cam_support.o \ + module_cam_physconst.o -module_sf_gfs.o: module_gfs_machine.o \ - module_gfs_funcphys.o \ - module_gfs_physcons.o \ - module_progtm.o -module_sf_noahdrv.o: module_sf_noahlsm.o \ - module_sf_noahlsm_glacial_only.o \ - module_data_gocart_dust.o \ - module_sf_urban.o module_sf_bep.o module_sf_bep_bem.o +module_cam_physconst.o: \ + module_cam_shr_kind_mod.o \ + module_cam_shr_const_mod.o -module_sf_noahlsm.o: ../share/module_model_constants.o -module_sf_clm.o: module_cam_shr_kind_mod.o \ - module_cam_shr_const_mod.o \ - module_cam_support.o \ - module_sf_urban.o \ - module_sf_noahlsm.o \ - module_ra_gfdleta.o \ - ../share/module_date_time.o \ - ../frame/module_wrf_error.o \ - ../frame/module_configure.o +module_cam_shr_const_mod.o: \ + module_cam_shr_kind_mod.o -module_sf_ctsm.o: ../frame/module_dm.o \ - ../frame/module_configure.o \ - ../frame/module_wrf_error.o -module_sf_ssib.o: ../share/module_model_constants.o +module_cam_support.o: \ + ../frame/module_wrf_error.o \ + module_cam_shr_kind_mod.o \ + ../frame/module_state_description.o -module_sf_noah_seaice_drv.o: module_sf_noah_seaice.o -module_sf_noah_seaice.o: module_sf_noahlsm.o ../share/module_model_constants.o +module_cam_shr_kind_mod.o: \ -module_sf_noahmpdrv.o: module_sf_noahmplsm.o \ - module_data_gocart_dust.o \ - module_sf_noahmp_glacier.o \ - module_sf_noahmp_groundwater.o \ - module_sf_gecros.o \ - ../share/module_model_constants.o \ - module_sf_urban.o module_sf_bep.o module_sf_bep_bem.o -module_sf_noahlsm_glacial_only.o: module_sf_noahlsm.o module_sf_noahmplsm.o +module_cu_kf.o: \ + ../frame/module_wrf_error.o -module_sf_noahmplsm.o: ../share/module_model_constants.o \ - module_sf_gecros.o \ - module_sf_myjsfc.o - -module_sf_noahmp_groundwater.o: module_sf_noahmplsm.o - -module_sf_bep.o: ../share/module_model_constants.o module_sf_urban.o module_bep_bem_helper.o - -module_sf_bep_bem.o: ../share/module_model_constants.o module_sf_bem.o module_sf_urban.o module_bep_bem_helper.o -module_sf_bem.o: ../share/module_model_constants.o +module_cu_kfcup.o: \ + ../frame/module_wrf_error.o \ + ../frame/module_state_description.o \ + $(CF2) \ + ../share/module_model_constants.o \ + module_mixactivate.o -module_sf_ruclsm.o: ../frame/module_wrf_error.o module_data_gocart_dust.o -module_sf_pxlsm.o: ../share/module_model_constants.o module_sf_pxlsm_data.o +module_cu_kfeta.o: \ + ../frame/module_wrf_error.o -module_ra_rrtmg_sw.o: module_ra_rrtmg_aero_optical_util_cmaq.o module_ra_rrtmg_lw.o -module_ra_rrtmg_swf.o: module_ra_rrtmg_lwf.o -module_ra_rrtmg_swk.o: module_ra_rrtmg_lwk.o module_ra_effective_radius.o -module_ra_rrtmg_lw.o: ../share/module_model_constants.o \ - module_ra_clWRF_support.o -module_ra_rrtmg_lwf.o: ../share/module_model_constants.o \ - module_ra_clWRF_support.o -module_ra_rrtmg_lwk.o: ../share/module_model_constants.o +module_cu_gd.o: \ -module_physics_addtendc.o: \ - module_cu_kf.o \ - module_cu_kfeta.o \ - $(PHYS_CU) \ - ../frame/module_state_description.o \ - ../frame/module_configure.o - -module_physics_init.o : \ - module_ra_rrtm.o \ - module_ra_rrtmg_lwf.o \ - module_ra_rrtmg_swf.o \ - module_ra_rrtmg_lw.o \ - module_ra_rrtmg_sw.o \ - module_ra_rrtmg_lwk.o \ - module_ra_rrtmg_swk.o \ - module_ra_cam.o \ - $(PHYS_CU) $(PHYS_BL) \ - module_ra_cam_support.o \ - module_ra_clWRF_support.o \ - module_ra_sw.o \ - module_ra_gsfcsw.o \ - module_ra_gfdleta.o \ - module_ra_hs.o \ - module_ra_flg.o \ - module_sf_sfclay.o \ - module_sf_sfclayrev.o \ - module_sf_slab.o \ - module_sf_myjsfc.o \ - module_sf_mynn.o \ - module_sf_fogdes.o \ - module_sf_urban.o \ - module_sf_qnsesfc.o \ - module_sf_pxsfclay.o \ - module_sf_noahlsm.o \ - module_sf_noahdrv.o \ - module_sf_clm.o \ - module_sf_ctsm.o \ - module_sf_ssib.o \ - module_sf_noahmplsm.o \ - module_sf_noahmpdrv.o \ - module_sf_bep.o \ - module_sf_bep_bem.o \ - module_sf_ruclsm.o \ - module_sf_pxlsm.o \ - module_sf_lake.o \ - module_bl_ysu.o \ - module_bl_mrf.o \ - module_bl_gfs.o \ - module_bl_gfsedmf.o \ - module_bl_acm.o \ - module_bl_myjpbl.o \ - module_bl_qnsepbl.o \ - module_bl_mynn.o \ - module_bl_mynn_wrapper.o \ - module_bl_myjurb.o \ - module_bl_boulac.o \ - module_bl_camuwpbl_driver.o \ - module_bl_temf.o \ - module_bl_mfshconvpbl.o \ - module_cu_kf.o \ - module_cu_g3.o \ - module_cu_kfeta.o \ - module_cu_mskf.o \ - module_cu_bmj.o \ - module_cu_gd.o \ - module_cu_ksas.o \ - module_cu_nsas.o \ - module_cu_sas.o \ - module_cu_scalesas.o \ - module_cu_osas.o \ - module_cu_camzm_driver.o \ - module_cu_kfcup.o \ - module_shcu_camuwshcu.o \ - module_shcu_deng.o \ - module_shcu_grims.o \ - module_mp_sbu_ylin.o \ - module_mp_wsm3.o \ - module_mp_wsm5.o \ - module_mp_wsm6.o \ - module_mp_wsm6r.o \ - module_mp_etanew.o \ - module_mp_fer_hires.o \ - module_mp_fast_sbm.o \ - module_fdda_psufddagd.o \ - module_fdda_spnudging.o \ - module_fddaobs_rtfdda.o \ - module_mp_thompson.o \ - module_mp_gsfcgce.o \ - module_mp_gsfcgce_4ice_nuwrf.o \ - module_mp_morr_two_moment.o \ - module_mp_milbrandt2mom.o \ - module_mp_nssl_2mom.o \ - module_mp_wdm5.o \ - module_mp_wdm6.o \ - module_cam_physconst.o \ - module_cam_shr_kind_mod.o \ - module_mp_cammgmp_driver.o \ - module_cam_esinti.o \ - module_cam_constituents.o \ - module_cam_mp_modal_aero_initialize_data_phys.o \ - module_cam_support.o \ - module_wind_fitch.o \ - module_gocart_coupling.o \ - module_data_gocart_dust.o \ - ../frame/module_state_description.o \ - ../frame/module_configure.o \ - ../frame/module_wrf_error.o \ - ../frame/module_dm.o \ - ../share/module_llxy.o \ - ../share/module_model_constants.o +module_cu_ksas.o: \ -module_microphysics_driver.o: \ - module_mixactivate.o \ - module_mp_kessler.o module_mp_sbu_ylin.o module_mp_lin.o \ - $(PHYS_MP) \ - module_mp_wsm3.o module_mp_wsm5.o \ - module_mp_wsm6.o module_mp_etanew.o \ - module_mp_wsm6r.o \ - module_mp_fer_hires.o \ - module_mp_thompson.o \ - module_mp_gsfcgce.o \ - module_mp_gsfcgce_4ice_nuwrf.o \ - module_mp_morr_two_moment.o \ - module_mp_morr_two_moment_aero.o \ - module_mp_milbrandt2mom.o \ - module_mp_nssl_2mom.o \ - module_mp_wdm5.o module_mp_wdm6.o \ - module_mp_cammgmp_driver.o \ - module_irrigation.o \ - module_mp_fast_sbm.o \ - ../frame/module_driver_constants.o \ - ../frame/module_state_description.o \ - ../frame/module_wrf_error.o \ - ../frame/module_configure.o \ - ../frame/module_comm_dm.o \ - ../frame/module_dm.o \ - ../share/module_model_constants.o -module_shallowcu_driver.o: \ - module_shcu_camuwshcu_driver.o \ - module_shcu_deng.o \ - ../frame/module_state_description.o \ - ../share/module_model_constants.o +module_cu_nsas.o: \ -module_cu_gf_deep.o: \ - module_cu_gf_ctrans.o -module_cu_gf_wrfdrv.o: \ - module_cu_gf_deep.o \ - module_cu_gf_sh.o -module_cu_gf_sh.o: \ - module_cu_gf_deep.o -module_cu_gf_ctrans.o: \ - ../chem/module_chem_utilities.o \ - ../share/module_HLaw.o \ - ../share/module_ctrans_aqchem.o \ - ../frame/module_state_description.o -module_cumulus_driver.o: \ - module_cu_kf.o \ - module_cu_g3.o \ - module_cu_gf_wrfdrv.o \ - module_cu_kfeta.o \ - $(PHYS_CU) \ - module_cu_bmj.o \ - module_cu_gd.o \ - module_cu_ksas.o \ - module_cu_nsas.o \ - module_cu_sas.o \ - module_cu_scalesas.o \ - module_cu_osas.o \ - module_cu_camzm_driver.o \ - module_cu_tiedtke.o \ - module_cu_ntiedtke.o \ - module_cu_mskf.o \ - module_cu_kfcup.o \ - ../frame/module_state_description.o \ - ../frame/module_configure.o \ - ../frame/module_domain.o \ - ../frame/module_dm.o \ - ../frame/module_comm_dm.o \ - ../frame/module_wrf_error.o \ - ../share/module_model_constants.o - -module_pbl_driver.o: \ - module_bl_myjpbl.o \ - module_bl_myjurb.o \ - module_bl_qnsepbl.o \ - module_bl_acm.o \ - module_bl_ysu.o \ - module_bl_mrf.o \ - module_bl_boulac.o \ - module_bl_camuwpbl_driver.o \ - module_bl_gfs.o \ - module_bl_gfsedmf.o \ - module_bl_mynn.o \ - module_bl_mynn_wrapper.o \ - module_bl_fogdes.o \ - module_bl_gwdo.o \ - module_bl_gwdo_gsl.o \ - module_bl_temf.o \ - module_bl_mfshconvpbl.o \ - $(PHYS_BL) \ - module_wind_fitch.o \ - ../frame/module_state_description.o \ - ../frame/module_configure.o \ - ../share/module_model_constants.o - -module_data_gocart_dust.o: -module_mixactivate.o: \ - module_radiation_driver.o +module_cu_du.o: \ + ../frame/module_wrf_error.o -module_radiation_driver.o: \ - module_ra_sw.o \ - module_ra_gsfcsw.o \ - module_ra_rrtm.o \ - module_ra_rrtmg_lw.o \ - module_ra_rrtmg_sw.o \ - module_ra_rrtmg_aero_optical_util_cmaq.o \ - module_ra_rrtmg_lwf.o \ - module_ra_rrtmg_swf.o \ - module_ra_rrtmg_lwk.o \ - module_ra_rrtmg_swk.o \ - module_ra_cam.o \ - module_ra_farms.o \ - module_ra_gfdleta.o \ - module_ra_hs.o \ - module_ra_goddard.o \ - module_ra_flg.o \ - module_ra_eclipse.o \ - module_ra_aerosol.o \ - module_mp_thompson.o \ - ../frame/module_driver_constants.o \ - ../frame/module_state_description.o \ - ../frame/module_dm.o \ - ../frame/module_comm_dm.o \ - ../frame/module_domain.o \ - ../frame/module_wrf_error.o \ - ../frame/module_configure.o \ - ../share/module_bc.o \ - ../share/module_model_constants.o -module_surface_driver.o: \ - module_sf_sfclay.o \ - module_sf_sfclayrev.o \ - module_sf_slab.o \ - module_sf_myjsfc.o \ - module_sf_qnsesfc.o \ - module_sf_pxsfclay.o \ - module_sf_gfs.o \ - module_sf_noah_seaice_drv.o \ - module_sf_noahmp_groundwater.o \ - module_sf_noahdrv.o \ - module_sf_clm.o \ - module_sf_ctsm.o \ - module_sf_ssib.o \ - module_sf_noahmpdrv.o \ - module_sf_ruclsm.o \ - module_sf_pxlsm.o \ - module_sf_mynn.o \ - module_sf_fogdes.o \ - module_sf_sfcdiags.o \ - module_sf_sfcdiags_ruclsm.o \ - module_sf_sstskin.o \ - module_sf_lake.o \ - module_sf_tmnupdate.o \ - module_sf_temfsfclay.o \ - module_sf_idealscmsfclay.o \ - module_sf_scmflux.o \ - module_sf_scmskintemp.o \ - module_sf_ocean_driver.o \ - module_irrigation.o \ - ../frame/module_state_description.o \ - ../frame/module_configure.o \ - ../frame/module_cpl.o \ - ../share/module_model_constants.o - -module_sf_ocean_driver.o : \ - module_sf_oml.o \ - module_sf_3dpwp.o \ - ../frame/module_state_description.o +module_gfs_physcons.o: \ + module_gfs_machine.o -module_diagnostics_driver.o: \ - module_lightning_driver.o \ - module_diag_misc.o \ - module_diag_nwp.o \ - module_diag_cl.o \ - module_diag_pld.o \ - module_diag_zld.o \ - module_diag_afwa.o \ - module_diag_hailcast.o \ - module_diag_rasm.o \ - module_diag_trad_fields.o \ - module_diag_solar.o \ - ../frame/module_comm_dm.o \ - ../frame/module_state_description.o \ - ../frame/module_domain.o \ - ../frame/module_configure.o \ - ../frame/module_driver_constants.o \ - ../share/module_model_constants.o -module_diag_misc.o: \ - ../frame/module_dm.o +module_gfs_funcphys.o: \ + module_gfs_machine.o \ + module_gfs_physcons.o -module_diag_cl.o: \ - ../frame/module_dm.o \ - ../frame/module_configure.o -module_diag_pld.o: \ - ../share/module_model_constants.o +module_cu_sas.o: \ + module_gfs_machine.o \ + module_gfs_funcphys.o \ + module_gfs_physcons.o -module_diag_zld.o: \ - ../share/module_model_constants.o -module_diag_afwa.o: \ - module_diag_trad_fields.o \ - ../frame/module_domain.o \ - ../frame/module_dm.o \ - ../frame/module_state_description.o \ - ../frame/module_configure.o \ - ../frame/module_streams.o \ - ../external/esmf_time_f90/module_utility.o \ - ../share/module_model_constants.o +module_cu_scalesas.o: \ + module_gfs_machine.o \ + module_gfs_funcphys.o \ + module_gfs_physcons.o -module_diag_hailcast.o: \ - ../frame/module_configure.o \ - ../frame/module_domain.o \ - ../frame/module_dm.o \ - ../frame/module_state_description.o \ - ../frame/module_streams.o \ - ../external/esmf_time_f90/module_utility.o \ - ../share/module_model_constants.o -module_diag_rasm.o: \ - module_cam_shr_const_mod.o +module_cu_osas.o: \ + module_gfs_machine.o \ + module_gfs_funcphys.o \ + module_gfs_physcons.o -module_diag_trad_fields.o: \ - module_diag_functions.o \ - ../share/module_model_constants.o -module_diag_solar.o: \ - ../share/module_model_constants.o +module_cu_tiedtke.o: \ + ../share/module_model_constants.o \ + module_gfs_machine.o \ + module_gfs_funcphys.o \ + module_gfs_physcons.o -module_diag_refl.o: \ - ../frame/module_dm.o \ - ../share/module_model_constants.o -module_mixactivate.o: \ - module_radiation_driver.o +module_cu_ntiedtke.o: \ + ../share/module_model_constants.o -module_fddagd_driver.o: \ - module_fdda_spnudging.o \ - module_fdda_psufddagd.o \ - ../frame/module_state_description.o \ - ../frame/module_configure.o \ - ../share/module_model_constants.o -module_fddaobs_driver.o: \ - ../frame/module_domain.o \ - ../share/module_bc.o \ - ../share/module_model_constants.o \ - module_fddaobs_rtfdda.o +module_ra_gfdleta.o: \ + ../frame/module_configure.o \ + ../share/module_model_constants.o \ + ../frame/module_dm.o \ + module_mp_etanew.o -module_sf_lake.o : \ - ../share/module_model_constants.o - -module_fr_fire_driver.o: \ - ../share/module_model_constants.o \ - ../frame/module_comm_dm.o \ - ../frame/module_domain.o \ - ../frame/module_configure.o \ - ../frame/module_dm.o \ - module_fr_fire_phys.o \ - module_fr_fire_model.o \ - module_fr_fire_util.o \ - module_fr_fire_core.o \ - module_fr_fire_atm.o +module_ra_rrtm.o: \ + ../frame/module_wrf_error.o \ + module_ra_clWRF_support.o \ + ../frame/module_dm.o -module_fr_fire_driver_wrf.o: \ - ../share/module_model_constants.o \ - ../frame/module_comm_dm.o \ - module_fr_fire_driver.o \ - module_fr_fire_atm.o \ - module_fr_fire_util.o -module_fr_fire_atm.o: \ - ../share/module_model_constants.o \ - module_fr_fire_util.o +module_ra_cam_support.o: \ + module_cam_support.o \ + ../frame/module_wrf_error.o -module_fr_fire_model.o: \ - module_fr_fire_core.o \ - module_fr_fire_phys.o \ - module_fr_fire_util.o -module_fr_fire_core.o: \ - module_fr_fire_util.o \ - module_fr_fire_phys.o +module_ra_cam.o: \ + module_ra_cam_support.o \ + module_ra_clWRF_support.o \ + module_ra_cam_support.o \ + module_cam_support.o \ + module_ra_clWRF_support.o \ + ../frame/module_wrf_error.o -module_fr_fire_phys.o: \ - ../share/module_model_constants.o \ - module_fr_fire_util.o -module_fire_debug_output.o: \ - ../frame/module_domain.o \ - ../frame/module_configure.o \ - ../share/mediation_integrate.o +module_mp_lin.o: \ + ../frame/module_wrf_error.o \ + module_mp_radar.o -module_firebrand_spotting_mpi.o: \ - ../frame/module_domain.o \ - ../frame/module_configure.o \ - ../frame/module_dm.o -module_firebrand_spotting.o: \ - ../frame/module_domain.o \ - ../frame/module_configure.o \ - ../frame/module_dm.o \ - ../frame/module_state_description.o \ - ../frame/module_domain_type.o \ - ../external/esmf_time_f90/module_symbols_util.o \ - ../external/esmf_time_f90/module_utility.o \ - module_firebrand_spotting_mpi.o +module_ra_flg.o: \ + ../frame/module_wrf_error.o \ + ../frame/module_dm.o -module_fdda_spnudging.o :\ - ../frame/module_dm.o \ - ../frame/module_state_description.o \ - ../frame/module_domain.o \ - ../frame/module_wrf_error.o -module_sf_bep.o :\ - module_sf_urban.o +module_mp_sbu_ylin.o: \ + ../frame/module_wrf_error.o \ + ../share/module_model_constants.o -module_mp_wsm5.o :\ - module_mp_wsm5_accel.F \ - module_mp_radar.o -module_mp_wdm5.o :\ - module_mp_radar.o +module_mp_milbrandt2mom.o: \ + ../frame/module_wrf_error.o \ + ../share/module_model_constants.o -module_mp_wsm6.o :\ - module_mp_radar.o -module_mp_wdm6.o :\ - module_mp_radar.o +module_mp_thompson.o: \ + ../frame/module_domain.o \ + ../share/module_model_constants.o \ + ../frame/module_timing.o \ + ../frame/module_wrf_error.o \ + module_mp_radar.o -module_mp_morr_two_moment.o :\ - module_mp_radar.o -module_mp_wsm3.o :\ - module_mp_wsm3_accel.F +module_mp_nssl_2mom.o: \ + ../frame/module_wrf_error.o \ + ../share/module_model_constants.o -module_mp_radar.o : -module_lightning_driver.o : \ - module_ltng_crmpr92.o module_ltng_cpmpr92z.o module_ltng_iccg.o +module_mp_fast_sbm.o: \ + ../frame/module_domain.o \ + module_mp_SBM_polar_radar.o \ + module_mp_radar.o -module_ltng_cpmpr92z.o : -module_ltng_crmpr92.o : +module_mp_full_sbm.o: \ + module_mp_radar.o -module_ltng_iccg.o : -module_ra_aerosol.o :\ - ../frame/module_wrf_error.o +module_mp_cammgmp_driver.o: \ + ../frame/module_configure.o \ + module_cam_mp_microp_aero.o \ + module_cam_constituents.o \ + module_cam_shr_kind_mod.o \ + module_cam_cldwat.o \ + module_cam_mp_cldwat2m_micro.o \ + module_cam_physconst.o \ + module_cam_support.o \ + module_data_cam_mam_aero.o \ + module_data_cam_mam_asect.o \ + module_cam_wv_saturation.o \ + module_cam_mp_ndrop.o \ + module_cam_mp_conv_water.o \ + ../frame/module_state_description.o -module_gocart_coupling.o: -module_ra_goddard.o : ../frame/module_wrf_error.o \ - module_gocart_coupling.o \ - module_checkerror.o +module_cam_mp_microp_aero.o: \ + module_cam_shr_kind_mod.o \ + module_cam_support.o \ + module_cam_physconst.o \ + module_cam_error_function.o \ + module_cam_wv_saturation.o \ + module_cam_mp_ndrop.o \ + module_data_cam_mam_aero.o -module_mp_gsfcgce_4ice_nuwrf.o : ../frame/module_wrf_error.o \ - module_gocart_coupling.o \ - module_checkerror.o \ - module_mp_radar.o -# End of DEPENDENCIES for phys +module_cam_mp_cldwat2m_micro.o: \ + module_cam_shr_kind_mod.o \ + module_cam_support.o \ + module_cam_physconst.o \ + module_cam_error_function.o \ + module_cam_wv_saturation.o -# DEPENDENCIES for share +module_cam_mp_ndrop.o: \ + module_cam_shr_kind_mod.o \ + module_data_cam_mam_aero.o \ + module_cam_support.o \ + module_cam_physconst.o \ + module_cam_constituents.o \ + module_cam_error_function.o \ + module_cam_wv_saturation.o -module_trajectory.o: ../frame/module_domain.o \ - ../frame/module_configure.o \ - ../frame/module_dm.o \ - ../frame/module_comm_dm.o \ - ../frame/module_state_description.o \ - module_model_constants.o \ - module_date_time.o \ - module_llxy.o -solve_interface.o: solve_em.int ../frame/module_domain.o ../frame/module_configure.o \ - ../frame/module_timing.o ../frame/module_driver_constants.o \ - ../frame/module_wrf_error.o \ - ../frame/module_state_description.o ../phys/module_checkerror.o \ - ../frame/module_wrf_error.o module_trajectory.o +module_cam_mp_modal_aero_initialize_data_phys.o: \ + module_data_cam_mam_aero.o -start_domain.o: start_domain_em.int wrf_timeseries.o track_driver.o ../frame/module_domain.o ../frame/module_configure.o ../share/module_llxy.o -module_date_time.o: ../frame/module_wrf_error.o ../frame/module_configure.o \ - module_model_constants.o +module_cam_mp_conv_water.o: \ + module_cam_shr_kind_mod.o \ + module_cam_support.o \ + module_cam_physconst.o -module_bc.o: ../frame/module_configure.o ../frame/module_state_description.o \ - ../frame/module_wrf_error.o module_model_constants.o -module_bc_time_utilities.o: $(ESMF_MOD_DEPENDENCE) +module_cam_mp_qneg3.o: \ + module_cam_shr_kind_mod.o \ + module_cam_support.o -module_get_file_names.o: ../frame/module_dm.o -module_io_wrf.o: module_date_time.o \ - ../frame/module_wrf_error.o ../frame/module_streams.o \ - $(ESMF_MOD_DEPENDENCE) +module_cam_mp_radconstants.o: \ + module_cam_shr_kind_mod.o \ + module_cam_support.o -module_io_domain.o: module_io_wrf.o module_date_time.o ../frame/module_io.o \ - ../frame/module_domain.o ../frame/module_configure.o \ - ../frame/module_state_description.o -output_wrf.o: ../frame/module_io.o ../frame/module_wrf_error.o \ - ../frame/module_domain.o ../frame/module_state_description.o \ - ../frame/module_configure.o module_io_wrf.o \ - $(ESMF_MOD_DEPENDENCE) +module_cam_infnan.o: \ + module_cam_shr_kind_mod.o -wrf_fddaobs_in.o: \ - module_date_time.o \ - module_llxy.o - -wrf_timeseries.o: wrf_tsin.o \ - module_model_constants.o \ - module_llxy.o \ - module_model_constants.o \ - module_string_tools.o \ - ../frame/module_domain.o \ - ../frame/module_configure.o \ - ../frame/module_dm.o - -track_driver.o: track_input.o \ - module_model_constants.o \ - module_llxy.o \ - module_date_time.o \ - ../frame/module_domain.o \ - ../frame/module_configure.o \ - ../frame/module_state_description.o \ - ../frame/module_dm.o - -input_wrf.o: ../frame/module_io.o ../frame/module_wrf_error.o \ - ../frame/module_domain.o ../frame/module_state_description.o \ - ../frame/module_configure.o module_io_wrf.o \ - $(ESMF_MOD_DEPENDENCE) - -wrf_ext_write_field.o : ../frame/module_io.o ../frame/module_wrf_error.o \ - ../frame/module_domain.o ../frame/module_timing.o - -wrf_ext_read_field.o : ../frame/module_io.o ../frame/module_wrf_error.o \ - ../frame/module_domain.o ../frame/module_timing.o - -module_soil_pre.o: module_date_time.o ../frame/module_state_description.o - -module_check_a_mundo.o: ../frame/module_configure.o ../frame/module_wrf_error.o \ - ../frame/module_state_description.o \ - ../share/module_model_constants.o \ - ../phys/module_bep_bem_helper.o - -dfi.o : ../frame/module_wrf_error.o ../frame/module_configure.o \ - ../frame/module_state_description.o \ - ../frame/module_domain.o ../frame/module_timing.o \ - ../frame/module_machine.o ../frame/module_comm_dm.o \ - ../frame/module_dm.o ../frame/module_driver_constants.o \ - module_model_constants.o module_date_time.o module_io_domain.o \ - $(ESMF_MOD_DEPENDENCE) - -module_optional_input.o: module_io_wrf.o module_io_domain.o \ - ../frame/module_domain.o ../frame/module_configure.o - -mediation_wrfmain.o: ../frame/module_domain.o ../frame/module_configure.o ../frame/module_dm.o \ - ../frame/module_timing.o $(ESMF_MOD_DEPENDENCE) \ - module_bc_time_utilities.o module_io_domain.o - -init_modules.o: ../frame/module_configure.o ../frame/module_driver_constants.o \ - ../frame/module_domain.o ../frame/module_machine.o \ - ../frame/module_nesting.o ../frame/module_timing.o \ - ../frame/module_tiles.o ../frame/module_io.o \ - ../frame/module_io_quilt.o ../frame/module_dm.o \ - ../external/io_int/io_int.o \ - module_io_wrf.o module_bc.o module_model_constants.o \ - ../frame/module_wrf_error.o - -interp_fcn.o: ../frame/module_timing.o ../frame/module_state_description.o ../frame/module_configure.o \ - ../frame/module_wrf_error.o module_model_constants.o module_interp_nmm.o module_interp_store.o - -module_interp_nmm.o: module_model_constants.o module_interp_store.o - -mediation_feedback_domain.o: ../frame/module_domain.o ../frame/module_configure.o \ - ../frame/module_intermediate_nmm.o - -mediation_force_domain.o: ../frame/module_domain.o ../frame/module_configure.o - -mediation_integrate.o: ../frame/module_domain.o ../frame/module_configure.o \ - ../frame/module_timing.o \ - $(ESMF_MOD_DEPENDENCE) \ - module_date_time.o module_bc_time_utilities.o \ - module_compute_geop.o \ - $(PERTMOD) \ - module_io_domain.o - - -mediation_interp_domain.o: ../frame/module_domain.o ../frame/module_configure.o \ - ../frame/module_timing.o -mediation_nest_move.o: \ - ../frame/module_domain.o \ - ../frame/module_configure.o \ - ../frame/module_state_description.o \ - ../frame/module_driver_constants.o \ - module_io_domain.o - -#mediation_conv_emissions.o: ../frame/module_domain.o ../frame/module_configure.o \ -# ../external/esmf_time_f90/ESMF_Mod.o \ -# module_date_time.o module_bc_time_utilities.o \ -# module_io_domain.o - -set_timekeeping.o: ../frame/module_domain.o ../frame/module_configure.o \ - $(ESMF_MOD_DEPENDENCE) - -wrf_inputout.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxinput1out.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxinput2out.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxinput3out.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxinput4out.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxinput5out.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxinput6out.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxinput7out.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxinput8out.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxinput9out.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxinput10out.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxinput11out.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_histout.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxhist1out.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxhist2out.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxhist3out.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxhist4out.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxhist5out.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxhist6out.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxhist7out.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxhist8out.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxhist9out.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxhist10out.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxhist11out.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_restartout.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_bdyout.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_inputin.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxhist1in.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxhist2in.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxhist3in.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxhist4in.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxhist5in.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxhist6in.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxhist7in.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxhist8in.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxhist9in.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxhist10in.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxhist11in.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxinput1in.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxinput2in.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxinput3in.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxinput4in.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxinput5in.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxinput6in.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxinput7in.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxinput8in.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxinput9in.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxinput10in.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_auxinput11in.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_bdyin.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_histin.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_restartin.o : ../frame/module_domain.o \ - ../frame/module_configure.o ../frame/module_io.o module_io_wrf.o module_bc_time_utilities.o -wrf_tsin.o : ../frame/module_domain.o - -track_input.o : ../frame/module_domain.o - -module_random.o: bobrand.o +module_mp_gsfcgce.o: \ + ../frame/module_wrf_error.o \ + module_mp_radar.o -# End of DEPENDENCIES for share +module_sf_myjsfc.o: \ + ../share/module_model_constants.o -# DEPENDENCIES for main -convert_em.o: \ - ../frame/module_machine.o \ - ../frame/module_domain.o \ - ../frame/module_driver_constants.o \ - ../frame/module_configure.o \ - ../frame/module_timing.o \ - ../frame/module_dm.o \ - ../share/module_bc.o \ - ../share/module_io_domain.o \ - $(ESMF_MOD_DEPENDENCE) +module_sf_qnsesfc.o: \ + ../share/module_model_constants.o -ideal_em.o: \ - ../frame/module_machine.o \ - ../frame/module_domain.o \ - ../frame/module_driver_constants.o \ - ../frame/module_configure.o \ - ../frame/module_timing.o \ - ../frame/module_dm.o \ - ../share/module_io_domain.o \ - ../dyn_$(SOLVER)/$(CASE_MODULE) \ - $(ESMF_MOD_DEPENDENCE) -ndown_em.o: \ - ../frame/module_machine.o \ - ../frame/module_domain.o \ - ../frame/module_driver_constants.o \ - ../frame/module_configure.o \ - ../frame/module_timing.o \ +module_sf_gfs.o: \ + module_gfs_machine.o \ + module_gfs_funcphys.o \ + module_gfs_physcons.o \ + module_progtm.o + + +module_sf_noahdrv.o: \ + module_ra_gfdleta.o \ + ../frame/module_wrf_error.o \ + module_sf_noahlsm.o \ + module_sf_noahlsm_glacial_only.o \ + module_data_gocart_dust.o \ + module_sf_urban.o \ + module_sf_bep.o \ + module_sf_bep_bem.o + + +module_sf_noahlsm.o: \ + ../frame/module_wrf_error.o \ + ../share/module_model_constants.o + + +module_sf_clm.o: \ + module_cam_shr_kind_mod.o \ + module_cam_shr_const_mod.o \ + module_cam_support.o \ + module_sf_urban.o \ + module_sf_noahlsm.o \ + module_ra_gfdleta.o \ + ../share/module_date_time.o \ + ../frame/module_wrf_error.o \ + ../frame/module_configure.o + + +module_sf_ctsm.o: \ ../frame/module_dm.o \ + ../frame/module_configure.o \ + ../frame/module_wrf_error.o + + +module_sf_ssib.o: \ + ../share/module_model_constants.o + + +module_sf_noah_seaice_drv.o: \ ../frame/module_wrf_error.o \ - ../frame/module_integrate.o \ - ../share/module_bc.o \ - ../share/module_io_domain.o \ - ../share/module_get_file_names.o \ + module_sf_noah_seaice.o + + +module_sf_noah_seaice.o: \ ../share/module_model_constants.o \ - ../share/module_soil_pre.o \ - ../dyn_em/module_initialize_$(IDEAL_CASE).o \ - ../dyn_em/module_big_step_utilities_em.o \ - ../dyn_em/nest_init_utils.o \ - $(ESMF_MOD_DEPENDENCE) + module_sf_noahlsm.o \ + module_sf_noahlsm.o \ + ../share/module_model_constants.o -# this already built above :../dyn_em/module_initialize.real.o \ -real_em.o: \ - ../frame/module_machine.o \ + +module_sf_noahmpdrv.o: \ + ../frame/module_comm_dm.o \ ../frame/module_domain.o \ - ../frame/module_driver_constants.o \ - ../frame/module_configure.o \ - ../frame/module_timing.o \ - ../frame/module_dm.o \ - ../dyn_em/module_initialize_$(IDEAL_CASE).o \ - ../dyn_em/module_big_step_utilities_em.o \ - ../share/module_io_domain.o \ - ../share/module_date_time.o \ - ../share/module_optional_input.o \ - ../share/module_bc_time_utilities.o \ - ../dyn_em/module_wps_io_arw.o \ - $(ESMF_MOD_DEPENDENCE) -# ../chem/module_input_chem_data.o \ -# ../chem/module_input_chem_bioemiss.o \ + module_ra_gfdleta.o \ + module_sf_noahmplsm.o \ + module_data_gocart_dust.o \ + module_sf_noahmp_glacier.o \ + module_sf_noahmp_groundwater.o \ + module_sf_gecros.o \ + ../share/module_model_constants.o \ + module_sf_urban.o \ + module_sf_bep.o \ + module_sf_bep_bem.o -tc_em.o: \ - ../frame/module_machine.o \ - ../frame/module_domain.o \ - ../frame/module_driver_constants.o \ - ../frame/module_configure.o \ - ../frame/module_timing.o \ - ../frame/module_dm.o \ - ../dyn_em/module_initialize_$(IDEAL_CASE).o \ - ../dyn_em/module_big_step_utilities_em.o \ - ../share/module_io_domain.o \ - ../share/module_date_time.o \ - ../share/module_optional_input.o \ - ../share/module_bc_time_utilities.o \ - $(ESMF_MOD_DEPENDENCE) +module_sf_noahlsm_glacial_only.o: \ + ../share/module_model_constants.o \ + ../frame/module_wrf_error.o \ + module_sf_noahlsm.o \ + module_sf_noahmplsm.o + + +module_sf_noahmplsm.o: \ + ../share/module_model_constants.o \ + module_sf_gecros.o \ + module_sf_myjsfc.o + + +module_sf_noahmp_groundwater.o: \ + module_sf_noahmplsm.o + + +module_sf_bep.o: \ + ../frame/module_wrf_error.o \ + ../share/module_model_constants.o \ + module_sf_urban.o \ + module_bep_bem_helper.o + +module_sf_bep_bem.o: \ + ../frame/module_wrf_error.o \ + ../share/module_model_constants.o \ + module_sf_bem.o \ + module_sf_urban.o \ + module_bep_bem_helper.o + + +module_sf_bem.o: \ + ../frame/module_wrf_error.o \ + ../share/module_model_constants.o + + +module_sf_ruclsm.o: \ + ../share/module_model_constants.o \ + ../frame/module_wrf_error.o \ + module_data_gocart_dust.o + + +module_sf_pxlsm.o: \ + ../share/module_model_constants.o \ + module_sf_pxlsm_data.o + + +module_ra_rrtmg_sw.o: \ + ../share/module_model_constants.o \ + module_ra_clWRF_support.o \ + ../frame/module_wrf_error.o \ + module_ra_rrtmg_aero_optical_util_cmaq.o \ + module_ra_rrtmg_lw.o -wrf.o: ../main/module_wrf_top.o +module_ra_rrtmg_swf.o: \ + ../share/module_model_constants.o \ + module_ra_clWRF_support.o \ + ../frame/module_wrf_error.o \ + module_ra_rrtmg_lwf.o + + +module_ra_rrtmg_swk.o: \ + ../share/module_model_constants.o \ + module_ra_rrtmg_lwk.o \ + module_ra_effective_radius.o + + +module_ra_rrtmg_lw.o: \ + ../frame/module_wrf_error.o \ + ../share/module_model_constants.o \ + module_ra_clWRF_support.o + -wrf_ESMFMod.o: ../main/module_wrf_top.o +module_ra_rrtmg_lwf.o: \ + ../frame/module_wrf_error.o \ + ../share/module_model_constants.o \ + module_ra_clWRF_support.o -wrf_SST_ESMF.o: wrf_ESMFMod.o -module_wrf_top.o: ../frame/module_machine.o \ - ../frame/module_domain.o \ - ../frame/module_integrate.o \ - ../frame/module_driver_constants.o \ - ../frame/module_configure.o \ - ../frame/module_timing.o \ - ../frame/module_wrf_error.o \ - ../frame/module_state_description.o \ - ../frame/module_cpl.o \ - $(ESMF_MOD_DEPENDENCE) +module_ra_rrtmg_lwk.o: \ + ../share/module_model_constants.o -# End of DEPENDENCIES for main +module_physics_addtendc.o: \ + module_cu_kf.o \ + module_cu_kfeta.o \ + $(PHYS_CU) \ + ../frame/module_state_description.o \ + ../frame/module_configure.o + + +module_physics_init.o: \ + module_bl_gbmpbl.o \ + module_bl_shinhong.o \ + module_cu_ntiedtke.o \ + module_cu_tiedtke.o \ + ../frame/module_domain.o \ + module_mp_full_sbm.o \ + module_mp_jensen_ishmael.o \ + module_mp_morr_two_moment_aero.o \ + module_mp_ntu.o \ + module_mp_wdm7.o \ + module_mp_wsm7.o \ + module_ra_goddard.o \ + module_sf_gfdl.o \ + module_sf_oml.o \ + module_sf_temfsfclay.o \ + module_shcu_nscv.o \ + module_ra_rrtm.o \ + module_ra_rrtmg_lwf.o \ + module_ra_rrtmg_swf.o \ + module_ra_rrtmg_lw.o \ + module_ra_rrtmg_sw.o \ + module_ra_rrtmg_lwk.o \ + module_ra_rrtmg_swk.o \ + module_ra_cam.o \ + $(PHYS_CU) \ + $(PHYS_BL) \ + module_ra_cam_support.o \ + module_ra_clWRF_support.o \ + module_ra_sw.o \ + module_ra_gsfcsw.o \ + module_ra_gfdleta.o \ + module_ra_hs.o \ + module_ra_flg.o \ + module_sf_sfclay.o \ + module_sf_sfclayrev.o \ + module_sf_slab.o \ + module_sf_myjsfc.o \ + module_sf_mynn.o \ + module_sf_fogdes.o \ + module_sf_urban.o \ + module_sf_qnsesfc.o \ + module_sf_pxsfclay.o \ + module_sf_noahlsm.o \ + module_sf_noahdrv.o \ + module_sf_clm.o \ + module_sf_ctsm.o \ + module_sf_ssib.o \ + module_sf_noahmplsm.o \ + module_sf_noahmpdrv.o \ + module_sf_bep.o \ + module_sf_bep_bem.o \ + module_sf_ruclsm.o \ + module_sf_pxlsm.o \ + module_sf_lake.o \ + module_bl_ysu.o \ + module_bl_mrf.o \ + module_bl_gfs.o \ + module_bl_gfsedmf.o \ + module_bl_acm.o \ + module_bl_myjpbl.o \ + module_bl_qnsepbl.o \ + module_bl_mynn.o \ + module_bl_mynn_wrapper.o \ + module_bl_myjurb.o \ + module_bl_boulac.o \ + module_bl_camuwpbl_driver.o \ + module_bl_temf.o \ + module_bl_mfshconvpbl.o \ + module_cu_kf.o \ + module_cu_g3.o \ + module_cu_kfeta.o \ + module_cu_mskf.o \ + module_cu_bmj.o \ + module_cu_gd.o \ + module_cu_ksas.o \ + module_cu_nsas.o \ + module_cu_sas.o \ + module_cu_scalesas.o \ + module_cu_osas.o \ + module_cu_camzm_driver.o \ + module_cu_kfcup.o \ + module_shcu_camuwshcu.o \ + module_shcu_deng.o \ + module_shcu_grims.o \ + module_mp_sbu_ylin.o \ + module_mp_wsm3.o \ + module_mp_wsm5.o \ + module_mp_wsm6.o \ + module_mp_wsm6r.o \ + module_mp_etanew.o \ + module_mp_fer_hires.o \ + module_mp_fast_sbm.o \ + module_fdda_psufddagd.o \ + module_fdda_spnudging.o \ + module_fddaobs_rtfdda.o \ + module_mp_thompson.o \ + module_mp_gsfcgce.o \ + module_mp_gsfcgce_4ice_nuwrf.o \ + module_mp_morr_two_moment.o \ + module_mp_milbrandt2mom.o \ + module_mp_nssl_2mom.o \ + module_mp_wdm5.o \ + module_mp_wdm6.o \ + module_cam_physconst.o \ + module_cam_shr_kind_mod.o \ + module_mp_cammgmp_driver.o \ + module_cam_esinti.o \ + module_cam_constituents.o \ + module_cam_mp_modal_aero_initialize_data_phys.o \ + module_cam_support.o \ + module_wind_fitch.o \ + module_gocart_coupling.o \ + module_data_gocart_dust.o \ + ../frame/module_state_description.o \ + ../frame/module_configure.o \ + ../frame/module_wrf_error.o \ + ../frame/module_dm.o \ + ../share/module_llxy.o \ + ../share/module_model_constants.o + + +module_microphysics_driver.o: \ + ../frame/module_domain.o \ + module_fire_emis.o \ + module_mp_full_sbm.o \ + module_mp_jensen_ishmael.o \ + module_mp_ntu.o \ + module_mp_wdm7.o \ + module_mp_wsm7.o \ + module_mixactivate.o \ + module_mp_kessler.o \ + module_mp_sbu_ylin.o \ + module_mp_lin.o \ + $(PHYS_MP) \ + module_mp_wsm3.o \ + module_mp_wsm5.o \ + module_mp_wsm6.o \ + module_mp_etanew.o \ + module_mp_wsm6r.o \ + module_mp_fer_hires.o \ + module_mp_thompson.o \ + module_mp_gsfcgce.o \ + module_mp_gsfcgce_4ice_nuwrf.o \ + module_mp_morr_two_moment.o \ + module_mp_morr_two_moment_aero.o \ + module_mp_milbrandt2mom.o \ + module_mp_nssl_2mom.o \ + module_mp_wdm5.o \ + module_mp_wdm6.o \ + module_mp_cammgmp_driver.o \ + module_irrigation.o \ + module_mp_fast_sbm.o \ + ../frame/module_driver_constants.o \ + ../frame/module_state_description.o \ + ../frame/module_wrf_error.o \ + ../frame/module_configure.o \ + ../frame/module_comm_dm.o \ + ../frame/module_dm.o \ + ../share/module_model_constants.o + + +module_shallowcu_driver.o: \ + ../frame/module_domain.o \ + module_shcu_grims.o \ + module_shcu_nscv.o \ + module_shcu_camuwshcu_driver.o \ + module_shcu_deng.o \ + ../frame/module_state_description.o \ + ../share/module_model_constants.o + + +module_cu_gf_deep.o: \ + module_cu_gf_ctrans.o + + +module_cu_gf_wrfdrv.o: \ + module_cu_gf_ctrans.o \ + module_gfs_physcons.o \ + module_cu_gf_deep.o \ + module_cu_gf_sh.o + + +module_cu_gf_sh.o: \ + module_cu_gf_ctrans.o \ + module_cu_gf_deep.o + + +module_cu_gf_ctrans.o: \ + ../chem/module_chem_utilities.o \ + ../share/module_HLaw.o \ + ../share/module_ctrans_aqchem.o \ + ../frame/module_state_description.o + + +module_cumulus_driver.o: \ + ../share/module_chem_share.o \ + module_cu_kf.o \ + module_cu_g3.o \ + module_cu_gf_wrfdrv.o \ + module_cu_kfeta.o \ + $(PHYS_CU) \ + module_cu_bmj.o \ + module_cu_gd.o \ + module_cu_ksas.o \ + module_cu_nsas.o \ + module_cu_sas.o \ + module_cu_scalesas.o \ + module_cu_osas.o \ + module_cu_camzm_driver.o \ + module_cu_tiedtke.o \ + module_cu_ntiedtke.o \ + module_cu_mskf.o \ + module_cu_kfcup.o \ + ../frame/module_state_description.o \ + ../frame/module_configure.o \ + ../frame/module_domain.o \ + ../frame/module_dm.o \ + ../frame/module_comm_dm.o \ + ../frame/module_wrf_error.o \ + ../share/module_model_constants.o + + +module_pbl_driver.o: \ + module_bl_gbmpbl.o \ + module_bl_keps.o \ + module_bl_shinhong.o \ + module_bl_myjpbl.o \ + module_bl_myjurb.o \ + module_bl_qnsepbl.o \ + module_bl_acm.o \ + module_bl_ysu.o \ + module_bl_mrf.o \ + module_bl_boulac.o \ + module_bl_camuwpbl_driver.o \ + module_bl_gfs.o \ + module_bl_gfsedmf.o \ + module_bl_mynn.o \ + module_bl_mynn_wrapper.o \ + module_bl_fogdes.o \ + module_bl_gwdo.o \ + module_bl_gwdo_gsl.o \ + module_bl_temf.o \ + module_bl_mfshconvpbl.o \ + $(PHYS_BL) \ + module_wind_fitch.o \ + ../frame/module_state_description.o \ + ../frame/module_configure.o \ + ../share/module_model_constants.o + + +module_data_gocart_dust.o: \ + + +module_mixactivate.o: \ + ../share/module_model_constants.o \ + module_radiation_driver.o + + +module_radiation_driver.o: \ + module_ra_sw.o \ + module_ra_gsfcsw.o \ + module_ra_rrtm.o \ + module_ra_rrtmg_lw.o \ + module_ra_rrtmg_sw.o \ + module_ra_rrtmg_aero_optical_util_cmaq.o \ + module_ra_rrtmg_lwf.o \ + module_ra_rrtmg_swf.o \ + module_ra_rrtmg_lwk.o \ + module_ra_rrtmg_swk.o \ + module_ra_cam.o \ + module_ra_farms.o \ + module_ra_gfdleta.o \ + module_ra_hs.o \ + module_ra_goddard.o \ + module_ra_flg.o \ + module_ra_eclipse.o \ + module_ra_aerosol.o \ + module_mp_thompson.o \ + ../frame/module_driver_constants.o \ + ../frame/module_state_description.o \ + ../frame/module_dm.o \ + ../frame/module_comm_dm.o \ + ../frame/module_domain.o \ + ../frame/module_wrf_error.o \ + ../frame/module_configure.o \ + ../share/module_bc.o \ + ../share/module_model_constants.o + + +module_surface_driver.o: \ + module_sf_noahlsm.o \ + module_sf_sfclay.o \ + module_sf_sfclayrev.o \ + module_sf_slab.o \ + module_sf_myjsfc.o \ + module_sf_qnsesfc.o \ + module_sf_pxsfclay.o \ + module_sf_gfs.o \ + module_sf_noah_seaice_drv.o \ + module_sf_noahmp_groundwater.o \ + module_sf_noahdrv.o \ + module_sf_clm.o \ + module_sf_ctsm.o \ + module_sf_ssib.o \ + module_sf_noahmpdrv.o \ + module_sf_ruclsm.o \ + module_sf_pxlsm.o \ + module_sf_mynn.o \ + module_sf_fogdes.o \ + module_sf_sfcdiags.o \ + module_sf_sfcdiags_ruclsm.o \ + module_sf_sstskin.o \ + module_sf_lake.o \ + module_sf_tmnupdate.o \ + module_sf_temfsfclay.o \ + module_sf_idealscmsfclay.o \ + module_sf_scmflux.o \ + module_sf_scmskintemp.o \ + module_sf_ocean_driver.o \ + module_irrigation.o \ + ../frame/module_state_description.o \ + ../frame/module_configure.o \ + ../frame/module_cpl.o \ + ../share/module_model_constants.o + + +module_sf_ocean_driver.o: \ + module_sf_oml.o \ + module_sf_3dpwp.o \ + ../frame/module_state_description.o + + +module_diagnostics_driver.o: \ + ../frame/module_streams.o \ + module_lightning_driver.o \ + module_diag_misc.o \ + module_diag_nwp.o \ + module_diag_cl.o \ + module_diag_pld.o \ + module_diag_zld.o \ + module_diag_afwa.o \ + module_diag_hailcast.o \ + module_diag_rasm.o \ + module_diag_trad_fields.o \ + module_diag_solar.o \ + ../frame/module_comm_dm.o \ + ../frame/module_state_description.o \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_driver_constants.o \ + ../share/module_model_constants.o + + +module_diag_misc.o: \ + ../frame/module_dm.o + + +module_diag_cl.o: \ + ../frame/module_dm.o \ + ../frame/module_configure.o + + +module_diag_pld.o: \ + ../share/module_model_constants.o + + +module_diag_zld.o: \ + ../share/module_model_constants.o + + +module_diag_afwa.o: \ + module_diag_trad_fields.o \ + ../frame/module_domain.o \ + ../frame/module_dm.o \ + ../frame/module_state_description.o \ + ../frame/module_configure.o \ + ../frame/module_streams.o \ + ../external/esmf_time_f90/module_utility.o \ + ../share/module_model_constants.o + + +module_diag_hailcast.o: \ + ../frame/module_configure.o \ + ../frame/module_domain.o \ + ../frame/module_dm.o \ + ../frame/module_state_description.o \ + ../frame/module_streams.o \ + ../external/esmf_time_f90/module_utility.o \ + ../share/module_model_constants.o + + +module_diag_rasm.o: \ + ../frame/module_domain.o \ + ../share/module_model_constants.o \ + ../frame/module_streams.o \ + module_cam_shr_const_mod.o + + +module_diag_trad_fields.o: \ + module_diag_functions.o \ + ../share/module_model_constants.o + + +module_diag_solar.o: \ + ../share/module_model_constants.o + + +module_diag_refl.o: \ + ../frame/module_dm.o \ + ../share/module_model_constants.o + + +module_mixactivate.o: \ + module_radiation_driver.o + + +module_fddagd_driver.o: \ + ../frame/module_domain.o \ + module_fdda_spnudging.o \ + module_fdda_psufddagd.o \ + ../frame/module_state_description.o \ + ../frame/module_configure.o \ + ../share/module_model_constants.o + + +module_fddaobs_driver.o: \ + ../frame/module_domain.o \ + ../share/module_bc.o \ + ../share/module_model_constants.o \ + module_fddaobs_rtfdda.o + + +module_sf_lake.o: \ + ../frame/module_wrf_error.o \ + ../share/module_model_constants.o + + +module_fr_fire_driver.o: \ + ../share/module_model_constants.o \ + ../frame/module_comm_dm.o \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_dm.o \ + module_fr_fire_phys.o \ + module_fr_fire_model.o \ + module_fr_fire_util.o \ + module_fr_fire_core.o \ + module_fr_fire_atm.o + + +module_fr_fire_driver_wrf.o: \ + ../frame/module_configure.o \ + ../frame/module_domain.o \ + ../share/module_model_constants.o \ + ../frame/module_comm_dm.o \ + module_fr_fire_driver.o \ + module_fr_fire_atm.o \ + module_fr_fire_util.o + + +module_fr_fire_atm.o: \ + ../share/module_model_constants.o \ + module_fr_fire_util.o + + +module_fr_fire_model.o: \ + ../frame/module_comm_dm.o \ + ../frame/module_configure.o \ + ../frame/module_domain.o \ + module_fr_fire_core.o \ + module_fr_fire_phys.o \ + module_fr_fire_util.o + + +module_fr_fire_core.o: \ + ../frame/module_comm_dm.o \ + ../frame/module_configure.o \ + ../frame/module_domain.o \ + module_fr_fire_util.o \ + module_fr_fire_phys.o + + +module_fr_fire_phys.o: \ + ../share/module_model_constants.o \ + module_fr_fire_util.o + + +module_fire_debug_output.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../share/mediation_integrate.o + + +module_firebrand_spotting_mpi.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_dm.o + + +module_firebrand_spotting.o: \ + ../frame/module_domain_type.o \ + module_firebrand_spotting_mpi.o \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_dm.o \ + ../frame/module_state_description.o \ + ../frame/module_domain_type.o \ + ../external/esmf_time_f90/module_symbols_util.o \ + ../external/esmf_time_f90/module_utility.o \ + module_firebrand_spotting_mpi.o + + +module_fdda_spnudging.o: \ + ../frame/module_dm.o \ + ../frame/module_state_description.o \ + ../frame/module_domain.o \ + ../frame/module_wrf_error.o + + +module_sf_bep.o: \ + module_sf_urban.o + + +module_mp_wsm5.o: \ + ../share/module_model_constants.o \ + module_mp_wsm5_accel.F \ + module_mp_radar.o + + +module_mp_wdm5.o: \ + ../share/module_model_constants.o \ + module_mp_radar.o + + +module_mp_wsm6.o: \ + ../share/module_model_constants.o \ + module_mp_radar.o + + +module_mp_wdm6.o: \ + ../share/module_model_constants.o \ + module_mp_radar.o + + +module_mp_morr_two_moment.o: \ + ../share/module_model_constants.o \ + module_mp_radar.o + + +module_mp_wsm3.o: \ + ../share/module_model_constants.o \ + module_mp_wsm3_accel.F + + +module_mp_radar.o: \ + ../frame/module_wrf_error.o + + +module_lightning_driver.o: \ + module_ltng_lpi.o \ + ../share/module_model_constants.o \ + ../frame/module_wrf_error.o \ + module_ltng_crmpr92.o \ + module_ltng_cpmpr92z.o \ + module_ltng_iccg.o + + +module_ltng_cpmpr92z.o: \ + ../share/module_model_constants.o \ + ../frame/module_wrf_error.o + + +module_ltng_crmpr92.o: \ + ../share/module_model_constants.o \ + ../frame/module_wrf_error.o + + +module_ltng_iccg.o: \ + + +module_ra_aerosol.o: \ + ../frame/module_wrf_error.o + + +module_gocart_coupling.o: \ + + +module_ra_goddard.o: \ + ../frame/module_wrf_error.o \ + module_gocart_coupling.o \ + module_checkerror.o + + +module_mp_gsfcgce_4ice_nuwrf.o: \ + ../frame/module_wrf_error.o \ + module_gocart_coupling.o \ + module_checkerror.o \ + module_mp_radar.o \ + +# End of DEPENDENCIES for phys + + +# DEPENDENCIES for share + +module_trajectory.o: \ + ../frame/module_domain_type.o \ + ../frame/module_driver_constants.o \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_dm.o \ + ../frame/module_comm_dm.o \ + ../frame/module_state_description.o \ + module_model_constants.o \ + module_date_time.o \ + module_llxy.o + + +solve_interface.o: \ + solve_em.int \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_timing.o \ + ../frame/module_driver_constants.o \ + ../frame/module_wrf_error.o \ + ../frame/module_state_description.o \ + ../phys/module_checkerror.o \ + ../frame/module_wrf_error.o \ + module_trajectory.o + + +start_domain.o: \ + start_domain_em.int \ + wrf_timeseries.o \ + track_driver.o \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../share/module_llxy.o + + +module_date_time.o: \ + ../frame/module_wrf_error.o \ + ../frame/module_configure.o \ + module_model_constants.o + + +module_bc.o: \ + ../frame/module_configure.o \ + ../frame/module_state_description.o \ + ../frame/module_wrf_error.o \ + module_model_constants.o + + +module_bc_time_utilities.o: \ + $(ESMF_MOD_DEPENDENCE) + + +module_get_file_names.o: \ + ../frame/module_dm.o + + +module_io_wrf.o: \ + module_date_time.o \ + ../frame/module_wrf_error.o \ + ../frame/module_streams.o \ + $(ESMF_MOD_DEPENDENCE) + + +module_io_domain.o: \ + module_io_wrf.o \ + module_date_time.o \ + ../frame/module_io.o \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_state_description.o + + +output_wrf.o: \ + ../frame/module_domain_type.o \ + module_model_constants.o \ + ../frame/module_io.o \ + ../frame/module_wrf_error.o \ + ../frame/module_domain.o \ + ../frame/module_state_description.o \ + ../frame/module_configure.o \ + module_io_wrf.o \ + $(ESMF_MOD_DEPENDENCE) + + +wrf_fddaobs_in.o: \ + ../frame/module_configure.o \ + ../frame/module_domain.o \ + module_model_constants.o \ + module_date_time.o \ + module_llxy.o + + +wrf_timeseries.o: \ + wrf_tsin.o \ + module_model_constants.o \ + module_llxy.o \ + module_model_constants.o \ + module_string_tools.o \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_dm.o + + +track_driver.o: \ + track_input.o \ + module_model_constants.o \ + module_llxy.o \ + module_date_time.o \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_state_description.o \ + ../frame/module_dm.o + + +input_wrf.o: \ + module_bc_time_utilities.o \ + module_date_time.o \ + ../frame/module_io.o \ + ../frame/module_wrf_error.o \ + ../frame/module_domain.o \ + ../frame/module_state_description.o \ + ../frame/module_configure.o \ + module_io_wrf.o \ + $(ESMF_MOD_DEPENDENCE) + + +wrf_ext_write_field.o: \ + ../frame/module_io.o \ + ../frame/module_wrf_error.o \ + ../frame/module_domain.o \ + ../frame/module_timing.o + + +wrf_ext_read_field.o: \ + ../frame/module_io.o \ + ../frame/module_wrf_error.o \ + ../frame/module_domain.o \ + ../frame/module_timing.o + + +module_soil_pre.o: \ + module_date_time.o \ + ../frame/module_state_description.o + + +module_check_a_mundo.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_wrf_error.o \ + ../frame/module_state_description.o \ + ../share/module_model_constants.o \ + ../phys/module_bep_bem_helper.o + + +dfi.o: \ + ../frame/module_wrf_error.o \ + ../frame/module_configure.o \ + ../frame/module_state_description.o \ + ../frame/module_domain.o \ + ../frame/module_timing.o \ + ../frame/module_machine.o \ + ../frame/module_comm_dm.o \ + ../frame/module_dm.o \ + ../frame/module_driver_constants.o \ + module_model_constants.o \ + module_date_time.o \ + module_io_domain.o \ + $(ESMF_MOD_DEPENDENCE) + + +module_optional_input.o: \ + module_io_wrf.o \ + module_io_domain.o \ + ../frame/module_domain.o \ + ../frame/module_configure.o + + +mediation_wrfmain.o: \ + ../frame/module_io.o \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_dm.o \ + ../frame/module_timing.o \ + $(ESMF_MOD_DEPENDENCE) \ + module_bc_time_utilities.o \ + module_io_domain.o + + +init_modules.o: \ + ../frame/module_cpl.o \ + ../frame/module_configure.o \ + ../frame/module_driver_constants.o \ + ../frame/module_domain.o \ + ../frame/module_machine.o \ + ../frame/module_nesting.o \ + ../frame/module_timing.o \ + ../frame/module_tiles.o \ + ../frame/module_io.o \ + ../frame/module_io_quilt.o \ + ../frame/module_dm.o \ + ../external/io_int/io_int.o \ + module_io_wrf.o \ + module_bc.o \ + module_model_constants.o \ + ../frame/module_wrf_error.o + + +interp_fcn.o: \ + ../frame/module_timing.o \ + ../frame/module_state_description.o \ + ../frame/module_configure.o \ + ../frame/module_wrf_error.o \ + module_model_constants.o \ + module_interp_nmm.o \ + module_interp_store.o + + +module_interp_nmm.o: \ + module_model_constants.o \ + module_interp_store.o + + +mediation_feedback_domain.o: \ + ../frame/module_timing.o \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_intermediate_nmm.o + + +mediation_force_domain.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o + + +mediation_integrate.o: \ + module_bc.o \ + ../dyn_em/module_bc_em.o \ + ../frame/module_comm_dm.o \ + ../frame/module_streams.o \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_timing.o \ + $(ESMF_MOD_DEPENDENCE) \ + module_date_time.o \ + module_bc_time_utilities.o \ + module_compute_geop.o \ + $(PERTMOD) \ + module_io_domain.o + + +mediation_interp_domain.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_timing.o + + +mediation_nest_move.o: \ + module_compute_geop.o \ + ../frame/module_streams.o \ + ../frame/module_timing.o \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_state_description.o \ + ../frame/module_driver_constants.o \ + module_io_domain.o + + +#mediation_conv_emissions.o: \ +# ../frame/module_domain.o \ +# ../frame/module_configure.o \ +# ../external/esmf_time_f90/ESMF_Mod.o \ +# module_date_time.o \ +# module_bc_time_utilities.o \ +# module_io_domain.o + + +set_timekeeping.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + $(ESMF_MOD_DEPENDENCE) + + +wrf_inputout.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxinput1out.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxinput2out.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxinput3out.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxinput4out.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxinput5out.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxinput6out.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxinput7out.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxinput8out.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxinput9out.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxinput10out.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxinput11out.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_histout.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxhist1out.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxhist2out.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxhist3out.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxhist4out.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxhist5out.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxhist6out.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxhist7out.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxhist8out.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxhist9out.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxhist10out.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxhist11out.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_restartout.o: \ + ../frame/module_wrf_error.o \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_bdyout.o: \ + ../frame/module_wrf_error.o \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_inputin.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxhist1in.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxhist2in.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxhist3in.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxhist4in.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxhist5in.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxhist6in.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxhist7in.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxhist8in.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxhist9in.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxhist10in.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxhist11in.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxinput1in.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxinput2in.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxinput3in.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxinput4in.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxinput5in.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxinput6in.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxinput7in.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxinput8in.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxinput9in.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxinput10in.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_auxinput11in.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_bdyin.o: \ + module_date_time.o \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_histin.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_restartin.o: \ + module_date_time.o \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_io.o \ + module_io_wrf.o \ + module_bc_time_utilities.o + + +wrf_tsin.o: \ + ../frame/module_domain.o + + +track_input.o: \ + ../frame/module_domain.o + + +module_random.o: \ + bobrand.o \ + +# End of DEPENDENCIES for share + +# DEPENDENCIES for main + +convert_em.o: \ + ../frame/module_machine.o \ + ../frame/module_domain.o \ + ../frame/module_driver_constants.o \ + ../frame/module_configure.o \ + ../frame/module_timing.o \ + ../frame/module_dm.o \ + ../share/module_bc.o \ + ../share/module_io_domain.o \ + $(ESMF_MOD_DEPENDENCE) + + +ideal_em.o: \ + ../share/module_check_a_mundo.o \ + ../dyn_em/module_initialize_ideal.o \ + ../frame/module_wrf_error.o \ + ../frame/module_machine.o \ + ../frame/module_domain.o \ + ../frame/module_driver_constants.o \ + ../frame/module_configure.o \ + ../frame/module_timing.o \ + ../frame/module_dm.o \ + ../share/module_io_domain.o \ + ../dyn_$(SOLVER)/$(CASE_MODULE) \ + $(ESMF_MOD_DEPENDENCE) + + +ndown_em.o: \ + ../share/module_check_a_mundo.o \ + ../frame/module_domain_type.o \ + ../dyn_em/module_initialize_real.o \ + ../share/module_optional_input.o \ + ../frame/module_machine.o \ + ../frame/module_domain.o \ + ../frame/module_driver_constants.o \ + ../frame/module_configure.o \ + ../frame/module_timing.o \ + ../frame/module_dm.o \ + ../frame/module_wrf_error.o \ + ../frame/module_integrate.o \ + ../share/module_bc.o \ + ../share/module_io_domain.o \ + ../share/module_get_file_names.o \ + ../share/module_model_constants.o \ + ../share/module_soil_pre.o \ + ../dyn_em/module_initialize_$(IDEAL_CASE).o \ + ../dyn_em/module_big_step_utilities_em.o \ + ../dyn_em/nest_init_utils.o \ + $(ESMF_MOD_DEPENDENCE) \ + + +# this already built above :../dyn_em/module_initialize.real.o \ +real_em.o: \ + ../share/module_bc.o \ + ../share/module_bc_time_utilities.o \ + ../dyn_em/module_big_step_utilities_em.o \ + ../share/module_check_a_mundo.o \ + ../frame/module_configure.o \ + ../share/module_date_time.o \ + ../frame/module_domain.o \ + ../frame/module_driver_constants.o \ + ../dyn_em/module_initialize_real.o \ + ../share/module_io_domain.o \ + ../frame/module_machine.o \ + ../share/module_optional_input.o \ + ../frame/module_timing.o \ + ../dyn_em/module_wps_io_arw.o \ + ../frame/module_machine.o \ + ../frame/module_domain.o \ + ../frame/module_driver_constants.o \ + ../frame/module_configure.o \ + ../frame/module_timing.o \ + ../frame/module_dm.o \ + ../dyn_em/module_initialize_$(IDEAL_CASE).o \ + ../dyn_em/module_big_step_utilities_em.o \ + ../share/module_io_domain.o \ + ../share/module_date_time.o \ + ../share/module_optional_input.o \ + ../share/module_bc_time_utilities.o \ + ../dyn_em/module_wps_io_arw.o \ + $(ESMF_MOD_DEPENDENCE) \ +# ../chem/module_input_chem_data.o \ +# ../chem/module_input_chem_bioemiss.o + + +tc_em.o: \ + ../share/module_bc.o \ + ../dyn_em/module_initialize_real.o \ + ../share/module_llxy.o \ + ../frame/module_machine.o \ + ../frame/module_domain.o \ + ../frame/module_driver_constants.o \ + ../frame/module_configure.o \ + ../frame/module_timing.o \ + ../frame/module_dm.o \ + ../dyn_em/module_initialize_$(IDEAL_CASE).o \ + ../dyn_em/module_big_step_utilities_em.o \ + ../share/module_io_domain.o \ + ../share/module_date_time.o \ + ../share/module_optional_input.o \ + ../share/module_bc_time_utilities.o \ + $(ESMF_MOD_DEPENDENCE) + + +wrf.o: \ + ../main/module_wrf_top.o + + +wrf_ESMFMod.o: \ + ../share/module_bc_time_utilities.o \ + ../frame/module_configure.o \ + ../frame/module_domain.o \ + ../share/module_io_domain.o \ + ../frame/module_streams.o \ + ../main/module_wrf_top.o + + +wrf_SST_ESMF.o: \ + ../frame/module_io.o \ + wrf_ESMFMod.o + + +module_wrf_top.o: \ + ../share/module_check_a_mundo.o \ + ../share/module_date_time.o \ + ../share/module_io_domain.o \ + ../frame/module_nesting.o \ + ../frame/module_machine.o \ + ../frame/module_domain.o \ + ../frame/module_integrate.o \ + ../frame/module_driver_constants.o \ + ../frame/module_configure.o \ + ../frame/module_timing.o \ + ../frame/module_wrf_error.o \ + ../frame/module_state_description.o \ + ../frame/module_cpl.o \ + $(ESMF_MOD_DEPENDENCE) \ + +# End of DEPENDENCIES for main + +ideal_nmm.o: \ + ../share/module_bc.o \ + ../share/module_bc_time_utilities.o \ + ../share/module_check_a_mundo.o \ + ../frame/module_configure.o \ + ../share/module_date_time.o \ + ../frame/module_domain.o \ + ../frame/module_driver_constants.o \ + ../dyn_em/module_initialize_ideal.o \ + ../share/module_io_domain.o \ + ../frame/module_machine.o \ + ../share/module_optional_input.o \ + ../frame/module_timing.o + + +real_nmm.o: \ + ../share/module_bc.o \ + ../share/module_bc_time_utilities.o \ + ../share/module_check_a_mundo.o \ + ../frame/module_configure.o \ + ../share/module_date_time.o \ + ../frame/module_domain.o \ + ../frame/module_driver_constants.o \ + ../dyn_em/module_initialize_real.o \ + ../share/module_io_domain.o \ + ../frame/module_machine.o \ + ../share/module_optional_input.o \ + ../frame/module_timing.o + + +module_dm_stubs.o: \ + module_driver_constants.o + + +module_io_quilt_old.o: \ + module_configure.o \ + module_cpl.o \ + module_driver_constants.o \ + module_internal_header_util.o \ + module_quilt_outbuf_ops.o \ + module_timing.o \ + module_wrf_error.o + + +module_bl_eepsilon.o: \ + ../share/module_model_constants.o + + +module_bl_mfshconvpbl.o: \ + ../share/module_model_constants.o + + +module_bl_mynn_common.o: \ + module_gfs_machine.o \ + ../share/module_model_constants.o \ + ccpp_kind_types.o + + +module_cu_mskf.o: \ + ../frame/module_wrf_error.o + + +module_diag_nwp.o: \ + module_mp_thompson.o + + +module_dust_emis.o: \ + module_data_gocart_dust.o + + +module_fddaobs_rtfdda.o: \ + ../frame/module_domain.o \ + ../share/module_model_constants.o + + +module_fdda_psufddagd.o: \ + ../share/module_model_constants.o + + +module_fr_fire_util.o: \ + ../frame/module_wrf_error.o + + +module_gocart_seasalt.o: \ + ../frame/module_configure.o \ + ../share/module_model_constants.o + + +module_microphysics_zero_out.o: \ + ../frame/module_configure.o \ + ../frame/module_wrf_error.o + + +module_mp_jensen_ishmael.o: \ + ../frame/module_wrf_error.o + + +module_mp_morr_two_moment_aero.o: \ + ../share/module_model_constants.o \ + module_mp_radar.o + + +module_mp_wdm7.o: \ + ../share/module_model_constants.o \ + module_mp_radar.o + + +module_mp_wsm7.o: \ + ../share/module_model_constants.o \ + module_mp_radar.o + + +module_ra_clWRF_support.o: \ + ../frame/module_wrf_error.o + + +module_ra_effective_radius.o: \ + ../share/module_model_constants.o + + +module_ra_farms.o: \ + ../share/module_model_constants.o + + +module_ra_rrtmg_aero_optical_util_cmaq.o: \ + complex_number_module.o + + +module_sf_sstskin.o: \ + ../frame/module_wrf_error.o + + +module_sf_urban.o: \ + ../frame/module_wrf_error.o + + +module_wind_fitch.o: \ + ../frame/module_configure.o \ + ../frame/module_driver_constants.o \ + ../share/module_llxy.o \ + ../share/module_model_constants.o + + +module_interp_store.o: \ + ../frame/module_domain_type.o + + +module_llxy.o: \ + ../frame/module_wrf_error.o + + +wrf_tsin.o: \ + ../frame/module_configure.o \ + module_string_tools.o + + +adapt_timestep_em.o: \ + module_bc_em.o \ + ../frame/module_configure.o \ + ../frame/module_domain.o + + +couple_or_uncouple_em.o: \ + ../share/module_bc.o \ + ../frame/module_comm_dm.o \ + ../frame/module_configure.o \ + ../frame/module_domain.o \ + ../frame/module_driver_constants.o \ + ../frame/module_machine.o \ + ../frame/module_tiles.o + + +interp_domain_em.o: \ + ../frame/module_configure.o \ + ../frame/module_domain.o + + +module_advect_em.o: \ + ../share/module_bc.o \ + ../share/module_model_constants.o \ + ../frame/module_wrf_error.o + + +module_after_all_rk_steps.o: \ + ../frame/module_comm_dm.o \ + ../frame/module_configure.o \ + ../phys/module_diagnostics_driver.o \ + ../frame/module_domain.o + + +module_avgflx_em.o: \ + ../share/module_bc.o \ + ../share/module_model_constants.o \ + ../frame/module_wrf_error.o + + +module_bc_em.o: \ + ../share/module_bc.o \ + ../frame/module_configure.o \ + ../share/module_model_constants.o \ + ../frame/module_wrf_error.o + + +module_big_step_utilities_em.o: \ + ../frame/module_configure.o \ + ../share/module_llxy.o \ + ../share/module_model_constants.o \ + ../frame/module_wrf_error.o + + +module_damping_em.o: \ + ../frame/module_wrf_error.o + + +module_diffusion_em.o: \ + ../share/module_bc.o \ + module_big_step_utilities_em.o \ + ../share/module_model_constants.o + + +module_em.o: \ + module_advect_em.o \ + module_big_step_utilities_em.o \ + ../frame/module_configure.o \ + module_damping_em.o \ + ../share/module_date_time.o \ + ../frame/module_domain.o \ + module_ieva_em.o \ + ../share/module_llxy.o \ + ../share/module_model_constants.o \ + ../share/module_trajectory.o + + +module_first_rk_step_part1.o: \ + module_big_step_utilities_em.o \ + ../frame/module_comm_dm.o \ + ../frame/module_configure.o \ + module_convtrans_prep.o \ + ../phys/module_cumulus_driver.o \ + ../frame/module_domain.o \ + module_em.o \ + ../phys/module_fddagd_driver.o \ + module_force_scm.o \ + ../phys/module_fr_fire_driver_wrf.o \ + ../share/module_model_constants.o \ + ../phys/module_pbl_driver.o \ + ../phys/module_radiation_driver.o \ + ../phys/module_shallowcu_driver.o \ + ../phys/module_surface_driver.o + + +module_first_rk_step_part2.o: \ + ../share/module_bc.o \ + module_big_step_utilities_em.o \ + ../frame/module_comm_dm.o \ + ../frame/module_configure.o \ + module_diffusion_em.o \ + ../frame/module_domain.o \ + ../frame/module_driver_constants.o \ + module_em.o \ + ../phys/module_fddaobs_driver.o \ + ../share/module_model_constants.o \ + ../phys/module_physics_addtendc.o \ + module_sfs_driver.o \ + module_stoch.o + + +module_force_scm.o: \ + module_init_utilities.o + + +module_ieva_em.o: \ + ../share/module_bc.o \ + ../share/module_model_constants.o \ + ../frame/module_wrf_error.o + + +module_initialize_fire.o: \ + ../share/module_bc.o \ + ../frame/module_configure.o \ + ../frame/module_domain.o \ + ../phys/module_fr_fire_phys.o \ + ../phys/module_fr_fire_util.o \ + module_init_utilities.o \ + ../share/module_io_domain.o \ + ../share/module_model_constants.o \ + ../share/module_soil_pre.o \ + ../frame/module_timing.o + + +module_initialize_heldsuarez.o: \ + ../share/module_bc.o \ + ../frame/module_configure.o \ + ../frame/module_domain.o \ + module_init_utilities.o \ + ../share/module_io_domain.o \ + ../share/module_model_constants.o \ + ../frame/module_timing.o + + +module_initialize_ideal.o: \ + ../share/module_bc.o \ + ../frame/module_configure.o \ + ../frame/module_domain.o \ + module_init_utilities.o \ + ../share/module_io_domain.o \ + ../share/module_model_constants.o \ + ../share/module_soil_pre.o \ + ../frame/module_timing.o + + +module_initialize_real.o: \ + ../share/module_bc.o \ + ../frame/module_comm_dm.o \ + ../frame/module_configure.o \ + ../share/module_date_time.o \ + ../frame/module_domain.o \ + ../share/module_io_domain.o \ + ../share/module_llxy.o \ + ../phys/module_madwrf.o \ + ../share/module_model_constants.o \ + ../share/module_optional_input.o \ + module_polarfft.o \ + ../phys/module_radiation_driver.o \ + ../share/module_soil_pre.o \ + ../frame/module_timing.o + + +module_initialize_scm_xy.o: \ + ../share/module_bc.o \ + ../frame/module_configure.o \ + ../frame/module_domain.o \ + module_init_utilities.o \ + ../share/module_io_domain.o \ + ../share/module_model_constants.o \ + ../share/module_optional_input.o \ + ../share/module_soil_pre.o \ + ../frame/module_timing.o + + +module_initialize_tropical_cyclone.o: \ + ../share/module_bc.o \ + ../frame/module_configure.o \ + ../frame/module_domain.o \ + module_init_utilities.o \ + ../share/module_io_domain.o \ + ../share/module_model_constants.o \ + ../share/module_soil_pre.o \ + ../frame/module_timing.o + + +module_polarfft.o: \ + ../frame/module_comm_dm.o \ + ../frame/module_domain.o \ + ../frame/module_driver_constants.o \ + ../share/module_model_constants.o \ + ../frame/module_wrf_error.o + + +module_positive_definite.o: \ + ../frame/module_wrf_error.o + + +module_sfs_driver.o: \ + ../share/module_bc.o \ + ../frame/module_comm_dm.o \ + ../frame/module_configure.o \ + ../frame/module_domain.o \ + ../frame/module_machine.o \ + ../share/module_model_constants.o \ + module_sfs_nba.o \ + ../frame/module_tiles.o + + +module_sfs_nba.o: \ + ../frame/module_configure.o + + +module_small_step_em.o: \ + ../frame/module_configure.o \ + ../share/module_model_constants.o + + +module_stoch.o: \ + ../frame/module_configure.o \ + ../frame/module_domain.o \ + ../frame/module_wrf_error.o + + +module_wps_io_arw.o: \ + ../frame/module_domain.o \ + ../frame/module_internal_header_util.o \ + ../share/module_optional_input.o \ + ../share/module_soil_pre.o + + +nest_init_utils.o: \ + ../share/module_bc.o \ + ../frame/module_comm_dm.o \ + ../frame/module_configure.o \ + ../frame/module_domain.o \ + ../frame/module_driver_constants.o \ + ../frame/module_machine.o \ + ../share/module_model_constants.o \ + ../frame/module_tiles.o + + +shift_domain_em.o: \ + ../frame/module_comm_dm.o \ + ../frame/module_configure.o \ + ../frame/module_domain.o \ + ../frame/module_domain_type.o \ + ../frame/module_timing.o + + +solve_em.o: \ + module_after_all_rk_steps.o \ + module_avgflx_em.o \ + ../share/module_bc.o \ + module_bc_em.o \ + module_big_step_utilities_em.o \ + ../frame/module_comm_dm.o \ + ../frame/module_configure.o \ + ../frame/module_cpl.o \ + module_diffusion_em.o \ + ../frame/module_domain.o \ + ../frame/module_domain_type.o \ + ../frame/module_driver_constants.o \ + ../phys/module_dust_emis.o \ + module_em.o \ + ../phys/module_fddaobs_driver.o \ + ../phys/module_firebrand_spotting.o \ + module_first_rk_step_part1.o \ + module_first_rk_step_part2.o \ + ../share/module_llxy.o \ + ../frame/module_machine.o \ + ../phys/module_microphysics_driver.o \ + ../phys/module_microphysics_zero_out.o \ + ../share/module_model_constants.o \ + ../phys/module_physics_addtendc.o \ + module_polarfft.o \ + module_small_step_em.o \ + module_solvedebug_em.o \ + ../frame/module_tiles.o + +start_em.o : \ + module_avgflx_em.o \ + ../share/module_bc.o \ + module_bc_em.o \ + ../frame/module_comm_dm.o \ + ../frame/module_configure.o \ + ../phys/module_diag_pld.o \ + ../phys/module_diag_zld.o \ + ../frame/module_domain.o \ + ../frame/module_driver_constants.o \ + ../phys/module_firebrand_spotting.o \ + ../phys/module_fr_fire_driver_wrf.o \ + ../phys/module_lightning_driver.o \ + ../share/module_llxy.o \ + ../share/module_model_constants.o \ + ../phys/module_physics_init.o \ + ../phys/noahmp/drivers/wrf/module_sf_noahmpdrv.o \ + module_stoch.o \ + ../frame/module_tiles.o \ + ../share/module_trajectory.o \ + ../frame/module_wrf_error.o