From 7844baa758ef76de213de1f34fd1357499ab056e Mon Sep 17 00:00:00 2001 From: Alexandre MARY Date: Thu, 23 Oct 2025 15:56:40 +0000 Subject: [PATCH 1/5] optional driver build --- CMakeLists.txt | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 9bcc3693..58a43319 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -65,6 +65,12 @@ ecbuild_add_option( REQUIRED_PACKAGES "OpenMP COMPONENTS Fortran" ) +ecbuild_add_option( + FEATURE DRIVER + DEFAULT ON + DESCRIPTION "Build the driver programs" +) + set( _PRECISIONS "" ) ecbuild_add_option( FEATURE DOUBLE_PRECISION @@ -140,7 +146,9 @@ foreach( PREC IN LISTS _PRECISIONS ) add_subdirectory(ifsrrtm ifsrrtm.${PREC}) add_subdirectory(radiation radiation.${PREC}) add_subdirectory(ifs ifs.${PREC}) - add_subdirectory(driver driver.${PREC}) + if( HAVE_DRIVER ) + add_subdirectory(driver driver.${PREC}) + endif() endforeach() # Include test directories only if tests are enabled (which is the default From b8773b7fb8890cbeb144e5edb254ad5a7c3c4055 Mon Sep 17 00:00:00 2001 From: Balthasar Reuter Date: Tue, 28 Oct 2025 16:32:54 +0100 Subject: [PATCH 2/5] Combine yomlun.F90 and yomlun_ifsaux.F90 into yomlun_ecrad.F90 to fix static linking with NVHPC (cherry picked from commit 5096990eb45079361f6231ea1780a5a28dde856f) --- bin/make_deps.sh | 2 +- ifs/cos_sza.F90 | 10 +++---- ifs/ice_effective_radius.F90 | 10 +++---- ifs/liquid_effective_radius.F90 | 26 +++++++++---------- ifs/radiation_scheme.F90 | 2 +- ifs/radiation_setup.F90 | 2 +- ifs/yoe_spectral_planck.F90 | 2 +- ifsaux/CMakeLists.txt | 3 +-- ifsaux/Makefile | 8 +++--- ifsaux/abor1.F90 | 2 +- ifsaux/yomlun.F90 | 24 ----------------- .../{yomlun_ifsaux.F90 => yomlun_ecrad.F90} | 11 ++++---- ifsrrtm/rrtm_init_140gp.F90 | 1 - ifsrrtm/rrtm_kgb1.F90 | 2 +- ifsrrtm/rrtm_kgb10.F90 | 2 +- ifsrrtm/rrtm_kgb11.F90 | 2 +- ifsrrtm/rrtm_kgb12.F90 | 2 +- ifsrrtm/rrtm_kgb13.F90 | 2 +- ifsrrtm/rrtm_kgb14.F90 | 2 +- ifsrrtm/rrtm_kgb15.F90 | 2 +- ifsrrtm/rrtm_kgb16.F90 | 2 +- ifsrrtm/rrtm_kgb2.F90 | 2 +- ifsrrtm/rrtm_kgb3.F90 | 2 +- ifsrrtm/rrtm_kgb4.F90 | 2 +- ifsrrtm/rrtm_kgb5.F90 | 2 +- ifsrrtm/rrtm_kgb6.F90 | 2 +- ifsrrtm/rrtm_kgb7.F90 | 2 +- ifsrrtm/rrtm_kgb8.F90 | 2 +- ifsrrtm/rrtm_kgb9.F90 | 2 +- ifsrrtm/srtm_init.F90 | 6 ++--- ifsrrtm/srtm_kgb16.F90 | 2 +- ifsrrtm/srtm_kgb17.F90 | 2 +- ifsrrtm/srtm_kgb18.F90 | 2 +- ifsrrtm/srtm_kgb19.F90 | 2 +- ifsrrtm/srtm_kgb20.F90 | 2 +- ifsrrtm/srtm_kgb21.F90 | 2 +- ifsrrtm/srtm_kgb22.F90 | 2 +- ifsrrtm/srtm_kgb23.F90 | 2 +- ifsrrtm/srtm_kgb24.F90 | 2 +- ifsrrtm/srtm_kgb25.F90 | 2 +- ifsrrtm/srtm_kgb27.F90 | 2 +- ifsrrtm/srtm_kgb28.F90 | 2 +- ifsrrtm/srtm_kgb29.F90 | 2 +- utilities/radiation_io.F90 | 2 +- 44 files changed, 71 insertions(+), 98 deletions(-) delete mode 100644 ifsaux/yomlun.F90 rename ifsaux/{yomlun_ifsaux.F90 => yomlun_ecrad.F90} (89%) diff --git a/bin/make_deps.sh b/bin/make_deps.sh index c154596b..08db1808 100755 --- a/bin/make_deps.sh +++ b/bin/make_deps.sh @@ -10,7 +10,7 @@ # nor does it submit to any jurisdiction. -EXT="parkind1.o|yomhook.o|yomcst.o|yomdyncore.o|yomlun.o|abor1.o|yomtag.o|mpl_module.o|yommp0_ifsaux.o" +EXT="parkind1.o|yomhook.o|yomcst.o|yomdyncore.o|yomlun_ecrad.o|abor1.o|yomtag.o|mpl_module.o|yommp0_ifsaux.o" while [ "$1" ] do diff --git a/ifs/cos_sza.F90 b/ifs/cos_sza.F90 index f4f51ff8..a2966551 100644 --- a/ifs/cos_sza.F90 +++ b/ifs/cos_sza.F90 @@ -1,6 +1,6 @@ SUBROUTINE COS_SZA(KSTART,KEND,KCOL,PGEMU,PGELAM,LDRADIATIONTIMESTEP,PMU0) -!**** *COS_SZA* +!**** *COS_SZA* ! ! (C) Copyright 2015- ECMWF. ! @@ -28,7 +28,7 @@ SUBROUTINE COS_SZA(KSTART,KEND,KCOL,PGEMU,PGELAM,LDRADIATIONTIMESTEP,PMU0) ! ---------- ! *CALL* *COS_SZA(...) -! Explicit arguments : +! Explicit arguments : ! ------------------ ! PGEMU - Sine of latitude ! PGELAM - Geographic longitude in radians @@ -82,7 +82,7 @@ SUBROUTINE COS_SZA(KSTART,KEND,KCOL,PGEMU,PGELAM,LDRADIATIONTIMESTEP,PMU0) USE YOMRIP , ONLY : YRRIP USE YOERIP , ONLY : YRERIP USE YOERAD , ONLY : YRERAD -USE YOMLUN , ONLY : NULOUT +USE YOMLUN_ECRAD, ONLY : NULOUT ! ------------------------------------------------------------------ @@ -189,7 +189,7 @@ SUBROUTINE COS_SZA(KSTART,KEND,KCOL,PGEMU,PGELAM,LDRADIATIONTIMESTEP,PMU0) ! range 0 to 2PI) IF (YRERIP%RWSOVRM + PGELAM(JCOL) < 2.0_JPRB*RPI) THEN ZHOURANGLESTART = ZSOLARTIMESTART + PGELAM(JCOL) - RPI - ZHOURANGLEEND = ZSOLARTIMEEND + PGELAM(JCOL) - RPI + ZHOURANGLEEND = ZSOLARTIMEEND + PGELAM(JCOL) - RPI ELSE ZHOURANGLESTART = ZSOLARTIMESTART + PGELAM(JCOL) - 3.0_JPRB*RPI ZHOURANGLEEND = ZSOLARTIMEEND + PGELAM(JCOL) - 3.0_JPRB*RPI @@ -288,7 +288,7 @@ SUBROUTINE COS_SZA(KSTART,KEND,KCOL,PGEMU,PGELAM,LDRADIATIONTIMESTEP,PMU0) ! range 0 to 2PI) IF (YRRIP%RWSOVR + PGELAM(JCOL) < 2.0_JPRB*RPI) THEN ZHOURANGLESTART = ZSOLARTIMESTART + PGELAM(JCOL) - RPI - ZHOURANGLEEND = ZSOLARTIMEEND + PGELAM(JCOL) - RPI + ZHOURANGLEEND = ZSOLARTIMEEND + PGELAM(JCOL) - RPI ELSE ZHOURANGLESTART = ZSOLARTIMESTART + PGELAM(JCOL) - 3.0_JPRB*RPI ZHOURANGLEEND = ZSOLARTIMEEND + PGELAM(JCOL) - 3.0_JPRB*RPI diff --git a/ifs/ice_effective_radius.F90 b/ifs/ice_effective_radius.F90 index 23de05f4..fc76cffc 100644 --- a/ifs/ice_effective_radius.F90 +++ b/ifs/ice_effective_radius.F90 @@ -32,7 +32,7 @@ SUBROUTINE ICE_EFFECTIVE_RADIUS & USE PARKIND1 , ONLY : JPIM, JPRB USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK USE YOERAD , ONLY : TERAD -USE YOMLUN , ONLY : NULERR +USE YOMLUN_ECRAD, ONLY : NULERR USE YOMCST , ONLY : RD, RTT ! ------------------------------------------------------------------- @@ -73,7 +73,7 @@ SUBROUTINE ICE_EFFECTIVE_RADIUS & REAL(KIND=JPRB) :: ZTEMPERATURE_C ! Temperature, degrees Celcius REAL(KIND=JPRB) :: ZAIWC, ZBIWC ! Factors in empirical relationship -REAL(KIND=JPRB) :: ZDEFAULT_RE_UM ! Default effective radius in microns +REAL(KIND=JPRB) :: ZDEFAULT_RE_UM ! Default effective radius in microns REAL(KIND=JPRB) :: ZDIAMETER_UM ! Effective diameter in microns ! Min effective diameter in microns; may vary with latitude @@ -96,7 +96,7 @@ SUBROUTINE ICE_EFFECTIVE_RADIUS & SELECT CASE(YDERAD%NRADIP) CASE(0) ! Ice effective radius fixed at 40 microns - PRE_UM(KIDIA:KFDIA,:) = 40.0_JPRB + PRE_UM(KIDIA:KFDIA,:) = 40.0_JPRB CASE(1,2) ! Ice effective radius from Liou and Ou (1994) @@ -162,7 +162,7 @@ SUBROUTINE ICE_EFFECTIVE_RADIUS & ENDIF ENDDO ENDDO - + CASE DEFAULT WRITE(NULERR,'(A,I0,A)') 'ICE EFFECTIVE RADIUS OPTION NRADLP=',YDERAD%NRADIP,' NOT AVAILABLE' CALL ABOR1('ERROR IN ICE_EFFECTIVE_RADIUS') @@ -172,5 +172,5 @@ SUBROUTINE ICE_EFFECTIVE_RADIUS & ! ------------------------------------------------------------------- IF (LHOOK) CALL DR_HOOK('ICE_EFFECTIVE_RADIUS',1,ZHOOK_HANDLE) - + END SUBROUTINE ICE_EFFECTIVE_RADIUS diff --git a/ifs/liquid_effective_radius.F90 b/ifs/liquid_effective_radius.F90 index cc44f984..36c0375d 100644 --- a/ifs/liquid_effective_radius.F90 +++ b/ifs/liquid_effective_radius.F90 @@ -34,7 +34,7 @@ SUBROUTINE LIQUID_EFFECTIVE_RADIUS & USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK USE YOERAD , ONLY : TERAD USE YOERDU , ONLY : REPLOG, REPSCW -USE YOMLUN , ONLY : NULERR +USE YOMLUN_ECRAD, ONLY : NULERR USE YOMCST , ONLY : RD, RPI ! ------------------------------------------------------------------- @@ -57,7 +57,7 @@ SUBROUTINE LIQUID_EFFECTIVE_RADIUS & REAL(KIND=JPRB), INTENT(IN) :: PQ_LIQ(KLON,KLEV) ! (kg/kg) REAL(KIND=JPRB), INTENT(IN) :: PQ_RAIN(KLON,KLEV) ! (kg/kg) -! *** Single-level variables +! *** Single-level variables REAL(KIND=JPRB), INTENT(IN) :: PLAND_FRAC(KLON) ! 1=land, 0=sea REAL(KIND=JPRB), INTENT(IN) :: PCCN_LAND(KLON) REAL(KIND=JPRB), INTENT(IN) :: PCCN_SEA(KLON) @@ -105,7 +105,7 @@ SUBROUTINE LIQUID_EFFECTIVE_RADIUS & ! Very old parameterization as a function of pressure, used in ERA-15 PRE_UM(KIDIA:KFDIA,:) = 10.0_JPRB& & + (100000.0_JPRB-PPRESSURE(KIDIA:KFDIA,:))*3.5_JPRB - + CASE(1) ! Simple distinction between land (10um) and ocean (13um) by Zhang ! and Rossow @@ -116,7 +116,7 @@ SUBROUTINE LIQUID_EFFECTIVE_RADIUS & PRE_UM(JL,:) = 10.0_JPRB ENDIF ENDDO - + CASE(2) ! Martin et al. (JAS 1994) DO JL = KIDIA,KFDIA @@ -134,9 +134,9 @@ SUBROUTINE LIQUID_EFFECTIVE_RADIUS & ZNTOT_CM3 = -1.15E-03_JPRB*ZCCN*ZCCN + 0.963_JPRB*ZCCN + 5.30_JPRB ELSE ! Land case - IF (YDERAD%LCCNL) THEN + IF (YDERAD%LCCNL) THEN ZCCN=PCCN_LAND(JL) - ELSE + ELSE ZCCN=YDERAD%RCCNLND ENDIF ZSPECTRAL_DISPERSION = 0.69_JPRB @@ -144,9 +144,9 @@ SUBROUTINE LIQUID_EFFECTIVE_RADIUS & ! land ZNTOT_CM3 = -2.10E-04_JPRB*ZCCN*ZCCN + 0.568_JPRB*ZCCN - 27.9_JPRB ENDIF - + ZRATIO = (0.222_JPRB/ZSPECTRAL_DISPERSION)**0.333_JPRB - + DO JK = 1,KLEV ! Only consider cloudy regions @@ -160,7 +160,7 @@ SUBROUTINE LIQUID_EFFECTIVE_RADIUS & ! fraction ZLWC_GM3 = ZAIR_DENSITY_GM3 * PQ_LIQ(JL,JK) / PCLOUD_FRAC(JL,JK) ZRWC_GM3 = ZAIR_DENSITY_GM3 * PQ_RAIN(JL,JK) / PCLOUD_FRAC(JL,JK) - + ! Wood's (2000, eq. 19) adjustment to Martin et al's ! parameterization IF (ZLWC_GM3 > REPSCW) THEN @@ -170,7 +170,7 @@ SUBROUTINE LIQUID_EFFECTIVE_RADIUS & ELSE ZWOOD_FACTOR = 1.0_JPRB ENDIF - + ! g m-3 and cm-3 units cancel out with density of water ! 10^6/(1000*1000); need a factor of 10^6 to convert to ! microns and cubed root is factor of 100 which appears in @@ -193,9 +193,9 @@ SUBROUTINE LIQUID_EFFECTIVE_RADIUS & ENDIF ENDDO - + ENDDO - + CASE DEFAULT WRITE(NULERR,'(A,I0,A)') 'LIQUID EFFECTIVE RADIUS OPTION IRADLP=',IRADLP,' NOT AVAILABLE' CALL ABOR1('ERROR IN LIQUID_EFFECTIVE_RADIUS') @@ -204,5 +204,5 @@ SUBROUTINE LIQUID_EFFECTIVE_RADIUS & ! ------------------------------------------------------------------- IF (LHOOK) CALL DR_HOOK('LIQUID_EFFECTIVE_RADIUS',1,ZHOOK_HANDLE) - + END SUBROUTINE LIQUID_EFFECTIVE_RADIUS diff --git a/ifs/radiation_scheme.F90 b/ifs/radiation_scheme.F90 index 805431ff..3b684916 100644 --- a/ifs/radiation_scheme.F90 +++ b/ifs/radiation_scheme.F90 @@ -70,7 +70,7 @@ SUBROUTINE RADIATION_SCHEME & USE PARKIND1 , ONLY : JPIM, JPRB, JPRD USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK USE YOMCST , ONLY : RPI, RSIGMA ! Stefan-Boltzmann constant -USE YOMLUN , ONLY : NULERR, NULOUT +USE YOMLUN_ECRAD , ONLY : NULERR, NULOUT USE RADIATION_SETUP, ONLY : ITYPE_TROP_BG_AER, ITYPE_STRAT_BG_AER, TRADIATION ! Modules from ecRad radiation library diff --git a/ifs/radiation_setup.F90 b/ifs/radiation_setup.F90 index aab30a8a..8f103323 100644 --- a/ifs/radiation_setup.F90 +++ b/ifs/radiation_setup.F90 @@ -109,7 +109,7 @@ MODULE RADIATION_SETUP SUBROUTINE SETUP_RADIATION_SCHEME(PRADIATION,LDOUTPUT,FILE_NAME) USE YOMHOOK, ONLY : LHOOK, DR_HOOK, JPHOOK - USE YOMLUN, ONLY : NULOUT, NULERR + USE YOMLUN_ECRAD, ONLY : NULOUT, NULERR !USE YOESRTWN, ONLY : NMPSRTM USE YOERAD, ONLY : TERAD USE YOEPHY, ONLY : TEPHY diff --git a/ifs/yoe_spectral_planck.F90 b/ifs/yoe_spectral_planck.F90 index e5d0ba14..c0602b63 100644 --- a/ifs/yoe_spectral_planck.F90 +++ b/ifs/yoe_spectral_planck.F90 @@ -82,7 +82,7 @@ SUBROUTINE INIT(SELF, KINTERVALS, PWAVLEN_BOUND, KINTERVAL_MAP) USE YOMCST, ONLY : RPI, RKBOL, RHPLA, RCLUM USE YOMHOOK, ONLY : LHOOK, DR_HOOK, JPHOOK - USE YOMLUN, ONLY : NULOUT + USE YOMLUN_ECRAD, ONLY : NULOUT CLASS(TSPECTRALPLANCK), INTENT(INOUT) :: SELF INTEGER(KIND=JPIM) , INTENT(IN) :: KINTERVALS diff --git a/ifsaux/CMakeLists.txt b/ifsaux/CMakeLists.txt index e78f8240..6c3ccbfa 100644 --- a/ifsaux/CMakeLists.txt +++ b/ifsaux/CMakeLists.txt @@ -10,8 +10,7 @@ set( ifsaux_SOURCES yomcst.F90 yomdyncore.F90 - yomlun_ifsaux.F90 - yomlun.F90 + yomlun_ecrad.F90 yommp0_ifsaux.F90 yomtag.F90 ) diff --git a/ifsaux/Makefile b/ifsaux/Makefile index 16bdd53c..b1c964db 100644 --- a/ifsaux/Makefile +++ b/ifsaux/Makefile @@ -1,5 +1,5 @@ -SOURCES = parkind1.F90 yomlun_ifsaux.F90 yomcst.F90 abor1.F90 \ - yomtag.F90 mpl_module.F90 yommp0_ifsaux.F90 yomdyncore.F90 yomlun.F90 +SOURCES = parkind1.F90 yomlun_ecrad.F90 yomcst.F90 abor1.F90 \ + yomtag.F90 mpl_module.F90 yommp0_ifsaux.F90 yomdyncore.F90 MAKE_INCLUDES = ../bin/make_intfbl.1.pl INCLUDE_DIR = ../include @@ -22,7 +22,7 @@ includes: clean: rm -f *.o $(LIBIFSAUX) -yomlun_ifsaux.o yomhook.o random_numbers_mix.o yomcst.o yomtag.o mpl_module.o yomdyncore.o: parkind1.o -abor1.o yomlun.o : yomlun_ifsaux.o +yomlun_ecrad.o yomhook.o random_numbers_mix.o yomcst.o yomtag.o mpl_module.o yomdyncore.o: parkind1.o +abor1.o: yomlun_ecrad.o .PHONY: deps includes diff --git a/ifsaux/abor1.F90 b/ifsaux/abor1.F90 index d8097f79..558cf38e 100644 --- a/ifsaux/abor1.F90 +++ b/ifsaux/abor1.F90 @@ -10,7 +10,7 @@ SUBROUTINE ABOR1(CDTEXT) USE PARKIND1, ONLY : JPIM, JPRB -USE YOMLUN_IFSAUX, ONLY : NULOUT, NULERR +USE YOMLUN_ECRAD, ONLY : NULOUT, NULERR IMPLICIT NONE diff --git a/ifsaux/yomlun.F90 b/ifsaux/yomlun.F90 deleted file mode 100644 index f81d6d3e..00000000 --- a/ifsaux/yomlun.F90 +++ /dev/null @@ -1,24 +0,0 @@ -! (C) Copyright 2014- ECMWF. -! -! This software is licensed under the terms of the Apache Licence Version 2.0 -! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. -! -! In applying this licence, ECMWF does not waive the privileges and immunities -! granted to it by virtue of its status as an intergovernmental organisation -! nor does it submit to any jurisdiction. - -MODULE YOMLUN - -USE PARKIND1, ONLY : JPIM -USE YOMLUN_IFSAUX, ONLY : NULOUT, NULERR - -IMPLICIT NONE - -PUBLIC - -SAVE - -INTEGER(KIND=JPIM) :: NULRAD = 25 - -! ------------------------------------------------------------------ -END MODULE YOMLUN diff --git a/ifsaux/yomlun_ifsaux.F90 b/ifsaux/yomlun_ecrad.F90 similarity index 89% rename from ifsaux/yomlun_ifsaux.F90 rename to ifsaux/yomlun_ecrad.F90 index 0998fcc4..689ff50b 100644 --- a/ifsaux/yomlun_ifsaux.F90 +++ b/ifsaux/yomlun_ecrad.F90 @@ -9,19 +9,18 @@ ! This is taken from yomlun_ifsaux in the IFS -MODULE YOMLUN_IFSAUX +MODULE YOMLUN_ECRAD #ifdef HAVE_FIAT USE EC_LUN ,ONLY : NULOUT, NULERR -#else -USE PARKIND1 ,ONLY : JPIM #endif +USE PARKIND1 ,ONLY : JPIM IMPLICIT NONE SAVE PRIVATE -PUBLIC :: NULOUT, NULERR +PUBLIC :: NULOUT, NULERR, NULRAD ! ------------------------------------------------------------------ @@ -35,5 +34,7 @@ MODULE YOMLUN_IFSAUX INTEGER(KIND=JPIM) :: NULERR = 0 #endif +INTEGER(KIND=JPIM) :: NULRAD = 25 + ! ------------------------------------------------------------------ -END MODULE YOMLUN_IFSAUX +END MODULE YOMLUN_ECRAD diff --git a/ifsrrtm/rrtm_init_140gp.F90 b/ifsrrtm/rrtm_init_140gp.F90 index 1e30459c..71958c0d 100644 --- a/ifsrrtm/rrtm_init_140gp.F90 +++ b/ifsrrtm/rrtm_init_140gp.F90 @@ -16,7 +16,6 @@ SUBROUTINE RRTM_INIT_140GP(CDIRECTORY) ! Output USE YOERRTBG2, ONLY : CORR1 ,CORR2 USE YOERRTRWT, ONLY : FREFA ,FREFB ,FREFADF ,FREFBDF ,RWGT -!USE YOMLUN , ONLY : NULOUT USE YOMMP0_IFSAUX, ONLY : NPROC, MYPROC USE MPL_MODULE, ONLY : MPL_NPROC, MPL_MYRANK diff --git a/ifsrrtm/rrtm_kgb1.F90 b/ifsrrtm/rrtm_kgb1.F90 index 740ddc74..0697b2c2 100644 --- a/ifsrrtm/rrtm_kgb1.F90 +++ b/ifsrrtm/rrtm_kgb1.F90 @@ -13,7 +13,7 @@ SUBROUTINE RRTM_KGB1(CDIRECTORY) USE PARKIND1 ,ONLY : JPRB USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN ,ONLY : NULRAD, NULOUT +USE YOMLUN_ECRAD,ONLY : NULRAD, NULOUT USE MPL_MODULE,ONLY : MPL_BROADCAST USE YOMTAG ,ONLY : MTAGRAD USE YOMMP0_IFSAUX ,ONLY : NPROC, MYPROC diff --git a/ifsrrtm/rrtm_kgb10.F90 b/ifsrrtm/rrtm_kgb10.F90 index c5d9d442..b2ec8d67 100644 --- a/ifsrrtm/rrtm_kgb10.F90 +++ b/ifsrrtm/rrtm_kgb10.F90 @@ -12,7 +12,7 @@ SUBROUTINE RRTM_KGB10 USE PARKIND1 ,ONLY : JPRB USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN ,ONLY : NULRAD +USE YOMLUN_ECRAD,ONLY : NULRAD USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC USE MPL_MODULE,ONLY : MPL_BROADCAST USE YOMTAG ,ONLY : MTAGRAD diff --git a/ifsrrtm/rrtm_kgb11.F90 b/ifsrrtm/rrtm_kgb11.F90 index 98f4986e..d68899a9 100644 --- a/ifsrrtm/rrtm_kgb11.F90 +++ b/ifsrrtm/rrtm_kgb11.F90 @@ -12,7 +12,7 @@ SUBROUTINE RRTM_KGB11 USE PARKIND1 ,ONLY : JPRB USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN ,ONLY : NULRAD +USE YOMLUN_ECRAD,ONLY : NULRAD USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC USE MPL_MODULE,ONLY : MPL_BROADCAST USE YOMTAG ,ONLY : MTAGRAD diff --git a/ifsrrtm/rrtm_kgb12.F90 b/ifsrrtm/rrtm_kgb12.F90 index 41105510..8c1ae575 100644 --- a/ifsrrtm/rrtm_kgb12.F90 +++ b/ifsrrtm/rrtm_kgb12.F90 @@ -11,7 +11,7 @@ SUBROUTINE RRTM_KGB12 USE PARKIND1 ,ONLY : JPRB USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN ,ONLY : NULRAD +USE YOMLUN_ECRAD,ONLY : NULRAD USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC USE MPL_MODULE,ONLY : MPL_BROADCAST USE YOMTAG ,ONLY : MTAGRAD diff --git a/ifsrrtm/rrtm_kgb13.F90 b/ifsrrtm/rrtm_kgb13.F90 index 3d5e6b72..5e0bfce9 100644 --- a/ifsrrtm/rrtm_kgb13.F90 +++ b/ifsrrtm/rrtm_kgb13.F90 @@ -12,7 +12,7 @@ SUBROUTINE RRTM_KGB13 USE PARKIND1 ,ONLY : JPRB USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN ,ONLY : NULRAD +USE YOMLUN_ECRAD,ONLY : NULRAD USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC USE MPL_MODULE,ONLY : MPL_BROADCAST USE YOMTAG ,ONLY : MTAGRAD diff --git a/ifsrrtm/rrtm_kgb14.F90 b/ifsrrtm/rrtm_kgb14.F90 index 0447103c..1f3ba30d 100644 --- a/ifsrrtm/rrtm_kgb14.F90 +++ b/ifsrrtm/rrtm_kgb14.F90 @@ -12,7 +12,7 @@ SUBROUTINE RRTM_KGB14 USE PARKIND1 ,ONLY : JPRB USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN ,ONLY : NULRAD +USE YOMLUN_ECRAD,ONLY : NULRAD USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC USE MPL_MODULE,ONLY : MPL_BROADCAST USE YOMTAG ,ONLY : MTAGRAD diff --git a/ifsrrtm/rrtm_kgb15.F90 b/ifsrrtm/rrtm_kgb15.F90 index 10e66324..f124fc7f 100644 --- a/ifsrrtm/rrtm_kgb15.F90 +++ b/ifsrrtm/rrtm_kgb15.F90 @@ -14,7 +14,7 @@ SUBROUTINE RRTM_KGB15 USE PARKIND1 ,ONLY : JPRB USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN ,ONLY : NULRAD +USE YOMLUN_ECRAD,ONLY : NULRAD USE MPL_MODULE,ONLY : MPL_BROADCAST USE YOMTAG ,ONLY : MTAGRAD USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC diff --git a/ifsrrtm/rrtm_kgb16.F90 b/ifsrrtm/rrtm_kgb16.F90 index 8bcaed01..2f6febc4 100644 --- a/ifsrrtm/rrtm_kgb16.F90 +++ b/ifsrrtm/rrtm_kgb16.F90 @@ -12,7 +12,7 @@ SUBROUTINE RRTM_KGB16 USE PARKIND1 ,ONLY : JPRB USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN ,ONLY : NULRAD +USE YOMLUN_ECRAD,ONLY : NULRAD USE MPL_MODULE,ONLY : MPL_BROADCAST USE YOMTAG ,ONLY : MTAGRAD diff --git a/ifsrrtm/rrtm_kgb2.F90 b/ifsrrtm/rrtm_kgb2.F90 index 6f9ccbb9..4f968e49 100644 --- a/ifsrrtm/rrtm_kgb2.F90 +++ b/ifsrrtm/rrtm_kgb2.F90 @@ -13,7 +13,7 @@ SUBROUTINE RRTM_KGB2 USE PARKIND1 ,ONLY : JPRB USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN ,ONLY : NULRAD +USE YOMLUN_ECRAD,ONLY : NULRAD USE MPL_MODULE,ONLY : MPL_BROADCAST USE YOMTAG ,ONLY : MTAGRAD diff --git a/ifsrrtm/rrtm_kgb3.F90 b/ifsrrtm/rrtm_kgb3.F90 index 12a259d0..11968266 100644 --- a/ifsrrtm/rrtm_kgb3.F90 +++ b/ifsrrtm/rrtm_kgb3.F90 @@ -14,7 +14,7 @@ SUBROUTINE RRTM_KGB3 USE PARKIND1 ,ONLY : JPRB USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN ,ONLY : NULRAD +USE YOMLUN_ECRAD,ONLY : NULRAD USE MPL_MODULE,ONLY : MPL_BROADCAST USE YOMTAG ,ONLY : MTAGRAD USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC diff --git a/ifsrrtm/rrtm_kgb4.F90 b/ifsrrtm/rrtm_kgb4.F90 index 028e972b..59ce73a9 100644 --- a/ifsrrtm/rrtm_kgb4.F90 +++ b/ifsrrtm/rrtm_kgb4.F90 @@ -12,7 +12,7 @@ SUBROUTINE RRTM_KGB4 USE PARKIND1 ,ONLY : JPRB USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN ,ONLY : NULRAD +USE YOMLUN_ECRAD,ONLY : NULRAD USE MPL_MODULE,ONLY : MPL_BROADCAST USE YOMTAG ,ONLY : MTAGRAD USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC diff --git a/ifsrrtm/rrtm_kgb5.F90 b/ifsrrtm/rrtm_kgb5.F90 index 7b14e4e6..37d0e3d7 100644 --- a/ifsrrtm/rrtm_kgb5.F90 +++ b/ifsrrtm/rrtm_kgb5.F90 @@ -12,7 +12,7 @@ SUBROUTINE RRTM_KGB5 USE PARKIND1 ,ONLY : JPRB USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN ,ONLY : NULRAD +USE YOMLUN_ECRAD,ONLY : NULRAD USE MPL_MODULE,ONLY : MPL_BROADCAST USE YOMTAG ,ONLY : MTAGRAD diff --git a/ifsrrtm/rrtm_kgb6.F90 b/ifsrrtm/rrtm_kgb6.F90 index 32a15972..1c57d211 100644 --- a/ifsrrtm/rrtm_kgb6.F90 +++ b/ifsrrtm/rrtm_kgb6.F90 @@ -12,7 +12,7 @@ SUBROUTINE RRTM_KGB6 USE PARKIND1 ,ONLY : JPRB USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN ,ONLY : NULRAD +USE YOMLUN_ECRAD,ONLY : NULRAD USE MPL_MODULE,ONLY : MPL_BROADCAST USE YOMTAG ,ONLY : MTAGRAD diff --git a/ifsrrtm/rrtm_kgb7.F90 b/ifsrrtm/rrtm_kgb7.F90 index 7ff249e3..c6d3b181 100644 --- a/ifsrrtm/rrtm_kgb7.F90 +++ b/ifsrrtm/rrtm_kgb7.F90 @@ -12,7 +12,7 @@ SUBROUTINE RRTM_KGB7 USE PARKIND1 ,ONLY : JPRB USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN ,ONLY : NULRAD +USE YOMLUN_ECRAD,ONLY : NULRAD USE MPL_MODULE,ONLY : MPL_BROADCAST USE YOMTAG ,ONLY : MTAGRAD diff --git a/ifsrrtm/rrtm_kgb8.F90 b/ifsrrtm/rrtm_kgb8.F90 index e95a8f99..d325e5df 100644 --- a/ifsrrtm/rrtm_kgb8.F90 +++ b/ifsrrtm/rrtm_kgb8.F90 @@ -12,7 +12,7 @@ SUBROUTINE RRTM_KGB8 USE PARKIND1 ,ONLY : JPRB USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN ,ONLY : NULRAD +USE YOMLUN_ECRAD,ONLY : NULRAD USE MPL_MODULE,ONLY : MPL_BROADCAST USE YOMTAG ,ONLY : MTAGRAD USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC diff --git a/ifsrrtm/rrtm_kgb9.F90 b/ifsrrtm/rrtm_kgb9.F90 index 04029d02..e827ac54 100644 --- a/ifsrrtm/rrtm_kgb9.F90 +++ b/ifsrrtm/rrtm_kgb9.F90 @@ -12,7 +12,7 @@ SUBROUTINE RRTM_KGB9 USE PARKIND1 ,ONLY : JPRB USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN ,ONLY : NULRAD +USE YOMLUN_ECRAD,ONLY : NULRAD USE MPL_MODULE,ONLY : MPL_BROADCAST USE YOMTAG ,ONLY : MTAGRAD USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC diff --git a/ifsrrtm/srtm_init.F90 b/ifsrrtm/srtm_init.F90 index 41902fb3..b984d31b 100644 --- a/ifsrrtm/srtm_init.F90 +++ b/ifsrrtm/srtm_init.F90 @@ -11,7 +11,6 @@ SUBROUTINE SRTM_INIT(CDIRECTORY, NWVCONTINUUM) USE YOESRTM , ONLY : NGN USE YOESRTWN , ONLY : NG, NGM, WT, NGC, RWGT, WTSM !USE YOESRTWN , ONLY : NG, NGM, WT, NGC, NGN, RWGT, WTSM -!USE YOMLUN , ONLY : NULOUT IMPLICIT NONE @@ -89,8 +88,8 @@ SUBROUTINE SRTM_INIT(CDIRECTORY, NWVCONTINUUM) END IF !-- read in the cloud optical properties -!- creates module YOESRTOP with EXTLIQ1, SSALIQ1, ASYLIQ1, -! EXTICE3, SSAICE3, ASYICE3, FDLICE3 +!- creates module YOESRTOP with EXTLIQ1, SSALIQ1, ASYLIQ1, +! EXTICE3, SSAICE3, ASYICE3, FDLICE3 !-- RRTM_SW cloud optical properties are not used ! SRTM_CLDPROP is not called @@ -150,4 +149,3 @@ SUBROUTINE SRTM_INIT(CDIRECTORY, NWVCONTINUUM) !----------------------------------------------------------------------- IF (LHOOK) CALL DR_HOOK('SRTM_INIT',1,ZHOOK_HANDLE) END SUBROUTINE SRTM_INIT - diff --git a/ifsrrtm/srtm_kgb16.F90 b/ifsrrtm/srtm_kgb16.F90 index 54c6783a..98a7c9d4 100644 --- a/ifsrrtm/srtm_kgb16.F90 +++ b/ifsrrtm/srtm_kgb16.F90 @@ -12,7 +12,7 @@ SUBROUTINE SRTM_KGB16(CDIRECTORY) USE PARKIND1 , ONLY : JPRB USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN , ONLY : NULRAD, NULOUT +USE YOMLUN_ECRAD, ONLY : NULRAD, NULOUT USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC USE MPL_MODULE, ONLY : MPL_BROADCAST USE YOMTAG , ONLY : MTAGRAD diff --git a/ifsrrtm/srtm_kgb17.F90 b/ifsrrtm/srtm_kgb17.F90 index ca51f5fe..cce6c8c2 100644 --- a/ifsrrtm/srtm_kgb17.F90 +++ b/ifsrrtm/srtm_kgb17.F90 @@ -12,7 +12,7 @@ SUBROUTINE SRTM_KGB17 USE PARKIND1 , ONLY : JPRB USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN , ONLY : NULRAD +USE YOMLUN_ECRAD, ONLY : NULRAD USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC USE MPL_MODULE, ONLY : MPL_BROADCAST USE YOMTAG , ONLY : MTAGRAD diff --git a/ifsrrtm/srtm_kgb18.F90 b/ifsrrtm/srtm_kgb18.F90 index f4dac467..e2c8ae2f 100644 --- a/ifsrrtm/srtm_kgb18.F90 +++ b/ifsrrtm/srtm_kgb18.F90 @@ -12,7 +12,7 @@ SUBROUTINE SRTM_KGB18 USE PARKIND1 , ONLY : JPRB USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN , ONLY : NULRAD +USE YOMLUN_ECRAD, ONLY : NULRAD USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC USE MPL_MODULE, ONLY : MPL_BROADCAST USE YOMTAG , ONLY : MTAGRAD diff --git a/ifsrrtm/srtm_kgb19.F90 b/ifsrrtm/srtm_kgb19.F90 index 4e569a5d..21352a36 100644 --- a/ifsrrtm/srtm_kgb19.F90 +++ b/ifsrrtm/srtm_kgb19.F90 @@ -12,7 +12,7 @@ SUBROUTINE SRTM_KGB19 USE PARKIND1 , ONLY : JPRB USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN , ONLY : NULRAD +USE YOMLUN_ECRAD, ONLY : NULRAD USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC USE MPL_MODULE, ONLY : MPL_BROADCAST USE YOMTAG , ONLY : MTAGRAD diff --git a/ifsrrtm/srtm_kgb20.F90 b/ifsrrtm/srtm_kgb20.F90 index a8d0ae38..ca2d878e 100644 --- a/ifsrrtm/srtm_kgb20.F90 +++ b/ifsrrtm/srtm_kgb20.F90 @@ -11,7 +11,7 @@ SUBROUTINE SRTM_KGB20 USE PARKIND1 , ONLY : JPRB USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN , ONLY : NULRAD +USE YOMLUN_ECRAD, ONLY : NULRAD USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC USE MPL_MODULE, ONLY : MPL_BROADCAST USE YOMTAG , ONLY : MTAGRAD diff --git a/ifsrrtm/srtm_kgb21.F90 b/ifsrrtm/srtm_kgb21.F90 index b5546d14..967d1656 100644 --- a/ifsrrtm/srtm_kgb21.F90 +++ b/ifsrrtm/srtm_kgb21.F90 @@ -12,7 +12,7 @@ SUBROUTINE SRTM_KGB21 USE PARKIND1 , ONLY : JPRB USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN , ONLY : NULRAD +USE YOMLUN_ECRAD, ONLY : NULRAD USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC USE MPL_MODULE, ONLY : MPL_BROADCAST USE YOMTAG , ONLY : MTAGRAD diff --git a/ifsrrtm/srtm_kgb22.F90 b/ifsrrtm/srtm_kgb22.F90 index e88e075c..077f894c 100644 --- a/ifsrrtm/srtm_kgb22.F90 +++ b/ifsrrtm/srtm_kgb22.F90 @@ -12,7 +12,7 @@ SUBROUTINE SRTM_KGB22 USE PARKIND1 , ONLY : JPRB USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN , ONLY : NULRAD +USE YOMLUN_ECRAD, ONLY : NULRAD USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC USE MPL_MODULE, ONLY : MPL_BROADCAST USE YOMTAG , ONLY : MTAGRAD diff --git a/ifsrrtm/srtm_kgb23.F90 b/ifsrrtm/srtm_kgb23.F90 index 20a1987f..396a9cd5 100644 --- a/ifsrrtm/srtm_kgb23.F90 +++ b/ifsrrtm/srtm_kgb23.F90 @@ -11,7 +11,7 @@ SUBROUTINE SRTM_KGB23 USE PARKIND1 , ONLY : JPRB USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN , ONLY : NULRAD +USE YOMLUN_ECRAD, ONLY : NULRAD USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC USE MPL_MODULE, ONLY : MPL_BROADCAST USE YOMTAG , ONLY : MTAGRAD diff --git a/ifsrrtm/srtm_kgb24.F90 b/ifsrrtm/srtm_kgb24.F90 index 9d0ef439..d4d789f5 100644 --- a/ifsrrtm/srtm_kgb24.F90 +++ b/ifsrrtm/srtm_kgb24.F90 @@ -12,7 +12,7 @@ SUBROUTINE SRTM_KGB24 USE PARKIND1 , ONLY : JPRB USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN , ONLY : NULRAD +USE YOMLUN_ECRAD, ONLY : NULRAD USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC USE MPL_MODULE, ONLY : MPL_BROADCAST USE YOMTAG , ONLY : MTAGRAD diff --git a/ifsrrtm/srtm_kgb25.F90 b/ifsrrtm/srtm_kgb25.F90 index 99173e3e..711d651a 100644 --- a/ifsrrtm/srtm_kgb25.F90 +++ b/ifsrrtm/srtm_kgb25.F90 @@ -11,7 +11,7 @@ SUBROUTINE SRTM_KGB25 USE PARKIND1 , ONLY : JPRB USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN , ONLY : NULRAD +USE YOMLUN_ECRAD, ONLY : NULRAD USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC USE MPL_MODULE, ONLY : MPL_BROADCAST USE YOMTAG , ONLY : MTAGRAD diff --git a/ifsrrtm/srtm_kgb27.F90 b/ifsrrtm/srtm_kgb27.F90 index f43bcbc3..fd018ad2 100644 --- a/ifsrrtm/srtm_kgb27.F90 +++ b/ifsrrtm/srtm_kgb27.F90 @@ -11,7 +11,7 @@ SUBROUTINE SRTM_KGB27 USE PARKIND1 , ONLY : JPRB USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN , ONLY : NULRAD +USE YOMLUN_ECRAD, ONLY : NULRAD USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC USE MPL_MODULE, ONLY : MPL_BROADCAST USE YOMTAG , ONLY : MTAGRAD diff --git a/ifsrrtm/srtm_kgb28.F90 b/ifsrrtm/srtm_kgb28.F90 index a45e632b..4b4bc584 100644 --- a/ifsrrtm/srtm_kgb28.F90 +++ b/ifsrrtm/srtm_kgb28.F90 @@ -12,7 +12,7 @@ SUBROUTINE SRTM_KGB28 USE PARKIND1 , ONLY : JPRB USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN , ONLY : NULRAD +USE YOMLUN_ECRAD, ONLY : NULRAD USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC USE MPL_MODULE, ONLY : MPL_BROADCAST USE YOMTAG , ONLY : MTAGRAD diff --git a/ifsrrtm/srtm_kgb29.F90 b/ifsrrtm/srtm_kgb29.F90 index 0be3fe6c..2d59b0cf 100644 --- a/ifsrrtm/srtm_kgb29.F90 +++ b/ifsrrtm/srtm_kgb29.F90 @@ -11,7 +11,7 @@ SUBROUTINE SRTM_KGB29 USE PARKIND1 , ONLY : JPRB USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN , ONLY : NULRAD +USE YOMLUN_ECRAD, ONLY : NULRAD USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC USE MPL_MODULE, ONLY : MPL_BROADCAST USE YOMTAG , ONLY : MTAGRAD diff --git a/utilities/radiation_io.F90 b/utilities/radiation_io.F90 index 24236314..12d03e13 100644 --- a/utilities/radiation_io.F90 +++ b/utilities/radiation_io.F90 @@ -29,7 +29,7 @@ module radiation_io ! equivalent to standard error, and text sent to this unit from any ! node will be logged. Normally, nulerr should only be used before ! calling radiation_abort. - use yomlun_ifsaux, only : nulout, nulerr + use yomlun_ecrad, only : nulout, nulerr implicit none public From 4044e772c53a0e41f51be6363730e9c23eeec084 Mon Sep 17 00:00:00 2001 From: Alexandre MARY Date: Thu, 9 Apr 2026 13:09:41 +0000 Subject: [PATCH 3/5] rename yomdyncore to avoid static linking issues --- bin/make_deps.sh | 2 +- ifsaux/CMakeLists.txt | 2 +- ifsaux/Makefile | 4 ++-- ifsaux/{yomdyncore.F90 => yomdyncore_ecrad.F90} | 4 ++-- ifsrrtm/DEPENDENCIES.txt | 2 +- ifsrrtm/rrtm_prepare_gases.F90 | 2 +- 6 files changed, 8 insertions(+), 8 deletions(-) rename ifsaux/{yomdyncore.F90 => yomdyncore_ecrad.F90} (91%) diff --git a/bin/make_deps.sh b/bin/make_deps.sh index 08db1808..3bafe6eb 100755 --- a/bin/make_deps.sh +++ b/bin/make_deps.sh @@ -10,7 +10,7 @@ # nor does it submit to any jurisdiction. -EXT="parkind1.o|yomhook.o|yomcst.o|yomdyncore.o|yomlun_ecrad.o|abor1.o|yomtag.o|mpl_module.o|yommp0_ifsaux.o" +EXT="parkind1.o|yomhook.o|yomcst.o|yomdyncore_ecrad.o|yomlun_ecrad.o|abor1.o|yomtag.o|mpl_module.o|yommp0_ifsaux.o" while [ "$1" ] do diff --git a/ifsaux/CMakeLists.txt b/ifsaux/CMakeLists.txt index 6c3ccbfa..72e0ded4 100644 --- a/ifsaux/CMakeLists.txt +++ b/ifsaux/CMakeLists.txt @@ -9,7 +9,7 @@ set( ifsaux_SOURCES yomcst.F90 - yomdyncore.F90 + yomdyncore_ecrad.F90 yomlun_ecrad.F90 yommp0_ifsaux.F90 yomtag.F90 diff --git a/ifsaux/Makefile b/ifsaux/Makefile index b1c964db..220ba6dd 100644 --- a/ifsaux/Makefile +++ b/ifsaux/Makefile @@ -1,5 +1,5 @@ SOURCES = parkind1.F90 yomlun_ecrad.F90 yomcst.F90 abor1.F90 \ - yomtag.F90 mpl_module.F90 yommp0_ifsaux.F90 yomdyncore.F90 + yomtag.F90 mpl_module.F90 yommp0_ifsaux.F90 yomdyncore_ecrad.F90 MAKE_INCLUDES = ../bin/make_intfbl.1.pl INCLUDE_DIR = ../include @@ -22,7 +22,7 @@ includes: clean: rm -f *.o $(LIBIFSAUX) -yomlun_ecrad.o yomhook.o random_numbers_mix.o yomcst.o yomtag.o mpl_module.o yomdyncore.o: parkind1.o +yomlun_ecrad.o yomhook.o random_numbers_mix.o yomcst.o yomtag.o mpl_module.o yomdyncore_ecrad.o: parkind1.o abor1.o: yomlun_ecrad.o .PHONY: deps includes diff --git a/ifsaux/yomdyncore.F90 b/ifsaux/yomdyncore_ecrad.F90 similarity index 91% rename from ifsaux/yomdyncore.F90 rename to ifsaux/yomdyncore_ecrad.F90 index 2492ec89..9ddb572d 100644 --- a/ifsaux/yomdyncore.F90 +++ b/ifsaux/yomdyncore_ecrad.F90 @@ -7,7 +7,7 @@ ! granted to it by virtue of its status as an intergovernmental organisation ! nor does it submit to any jurisdiction. -MODULE YOMDYNCORE +MODULE YOMDYNCORE_ECRAD USE PARKIND1 ,ONLY : JPRB @@ -23,4 +23,4 @@ MODULE YOMDYNCORE REAL(KIND=JPRB) :: RPLRG = 1.0 -END MODULE YOMDYNCORE +END MODULE YOMDYNCORE_ECRAD diff --git a/ifsrrtm/DEPENDENCIES.txt b/ifsrrtm/DEPENDENCIES.txt index f3a4493e..9b26583b 100644 --- a/ifsrrtm/DEPENDENCIES.txt +++ b/ifsrrtm/DEPENDENCIES.txt @@ -44,7 +44,7 @@ YOESRTWN YOESW YOMCST YOMDIMV -YOMDYNCORE +YOMDYNCORE_ECRAD YOMHOOK YOMPHY3 YOM_YGFL diff --git a/ifsrrtm/rrtm_prepare_gases.F90 b/ifsrrtm/rrtm_prepare_gases.F90 index 8d831dc0..4752df70 100644 --- a/ifsrrtm/rrtm_prepare_gases.F90 +++ b/ifsrrtm/rrtm_prepare_gases.F90 @@ -22,7 +22,7 @@ SUBROUTINE RRTM_PREPARE_GASES & USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK USE YOMCST , ONLY : RG USE PARRRTM , ONLY : JPXSEC, JPINPX -USE YOMDYNCORE,ONLY : RPLRG +USE YOMDYNCORE_ECRAD,ONLY : RPLRG !------------------------------Arguments-------------------------------- From 1f84fd161bd7361caabc5ff83931d58c06f94db5 Mon Sep 17 00:00:00 2001 From: Philippe Marguinaud Date: Tue, 12 May 2026 08:31:57 +0000 Subject: [PATCH 4/5] Compile with ECRAD source code from cycle 50t2 --- .gitignore | 1 + ifs/radiation_setup.F90 | 5 +- ifsrrtm/parrrtm.F90 | 11 +- ifsrrtm/parsrtm.F90 | 11 +- ifsrrtm/rrtm_cmbgb1.F90 | 9 + ifsrrtm/rrtm_cmbgb10.F90 | 9 + ifsrrtm/rrtm_cmbgb11.F90 | 9 + ifsrrtm/rrtm_cmbgb12.F90 | 9 + ifsrrtm/rrtm_cmbgb13.F90 | 9 + ifsrrtm/rrtm_cmbgb14.F90 | 9 + ifsrrtm/rrtm_cmbgb15.F90 | 9 + ifsrrtm/rrtm_cmbgb16.F90 | 9 + ifsrrtm/rrtm_cmbgb2.F90 | 9 + ifsrrtm/rrtm_cmbgb3.F90 | 9 + ifsrrtm/rrtm_cmbgb4.F90 | 9 + ifsrrtm/rrtm_cmbgb5.F90 | 9 + ifsrrtm/rrtm_cmbgb6.F90 | 9 + ifsrrtm/rrtm_cmbgb7.F90 | 9 + ifsrrtm/rrtm_cmbgb8.F90 | 9 + ifsrrtm/rrtm_cmbgb9.F90 | 9 + ifsrrtm/rrtm_gas_optical_depth.F90 | 9 + ifsrrtm/rrtm_init_140gp.F90 | 11 +- ifsrrtm/rrtm_kgb1.F90 | 53 +- ifsrrtm/rrtm_kgb10.F90 | 47 +- ifsrrtm/rrtm_kgb11.F90 | 63 ++- ifsrrtm/rrtm_kgb12.F90 | 27 +- ifsrrtm/rrtm_kgb13.F90 | 49 +- ifsrrtm/rrtm_kgb14.F90 | 47 +- ifsrrtm/rrtm_kgb15.F90 | 39 +- ifsrrtm/rrtm_kgb16.F90 | 39 +- ifsrrtm/rrtm_kgb2.F90 | 51 +- ifsrrtm/rrtm_kgb3.F90 | 67 +-- ifsrrtm/rrtm_kgb4.F90 | 39 +- ifsrrtm/rrtm_kgb5.F90 | 55 +- ifsrrtm/rrtm_kgb6.F90 | 49 +- ifsrrtm/rrtm_kgb7.F90 | 59 ++- ifsrrtm/rrtm_kgb8.F90 | 77 +-- ifsrrtm/rrtm_kgb9.F90 | 59 ++- ifsrrtm/rrtm_prepare_gases.F90 | 12 +- ifsrrtm/rrtm_setcoef_140gp.F90 | 9 + ifsrrtm/rrtm_taumol1.F90 | 9 + ifsrrtm/rrtm_taumol10.F90 | 9 + ifsrrtm/rrtm_taumol11.F90 | 9 + ifsrrtm/rrtm_taumol12.F90 | 9 + ifsrrtm/rrtm_taumol13.F90 | 9 + ifsrrtm/rrtm_taumol14.F90 | 9 + ifsrrtm/rrtm_taumol15.F90 | 9 + ifsrrtm/rrtm_taumol16.F90 | 9 + ifsrrtm/rrtm_taumol2.F90 | 9 + ifsrrtm/rrtm_taumol3.F90 | 9 + ifsrrtm/rrtm_taumol4.F90 | 9 + ifsrrtm/rrtm_taumol5.F90 | 9 + ifsrrtm/rrtm_taumol6.F90 | 9 + ifsrrtm/rrtm_taumol7.F90 | 9 + ifsrrtm/rrtm_taumol8.F90 | 9 + ifsrrtm/rrtm_taumol9.F90 | 9 + ifsrrtm/srtm_cmbgb16.F90 | 9 + ifsrrtm/srtm_cmbgb17.F90 | 9 + ifsrrtm/srtm_cmbgb18.F90 | 9 + ifsrrtm/srtm_cmbgb19.F90 | 9 + ifsrrtm/srtm_cmbgb20.F90 | 9 + ifsrrtm/srtm_cmbgb21.F90 | 9 + ifsrrtm/srtm_cmbgb22.F90 | 9 + ifsrrtm/srtm_cmbgb23.F90 | 9 + ifsrrtm/srtm_cmbgb24.F90 | 9 + ifsrrtm/srtm_cmbgb25.F90 | 9 + ifsrrtm/srtm_cmbgb26.F90 | 9 + ifsrrtm/srtm_cmbgb27.F90 | 9 + ifsrrtm/srtm_cmbgb28.F90 | 9 + ifsrrtm/srtm_cmbgb29.F90 | 9 + ifsrrtm/srtm_gas_optical_depth.F90 | 9 + ifsrrtm/srtm_init.F90 | 17 +- ifsrrtm/srtm_kgb16.F90 | 75 +-- ifsrrtm/srtm_kgb17.F90 | 87 ++-- ifsrrtm/srtm_kgb18.F90 | 91 ++-- ifsrrtm/srtm_kgb19.F90 | 89 ++-- ifsrrtm/srtm_kgb20.F90 | 75 +-- ifsrrtm/srtm_kgb21.F90 | 85 +-- ifsrrtm/srtm_kgb22.F90 | 85 +-- ifsrrtm/srtm_kgb23.F90 | 63 ++- ifsrrtm/srtm_kgb24.F90 | 109 ++-- ifsrrtm/srtm_kgb25.F90 | 35 +- ifsrrtm/srtm_kgb26.F90 | 9 + ifsrrtm/srtm_kgb27.F90 | 43 +- ifsrrtm/srtm_kgb28.F90 | 45 +- ifsrrtm/srtm_kgb29.F90 | 79 +-- ifsrrtm/srtm_setcoef.F90 | 9 + ifsrrtm/srtm_taumol16.F90 | 27 +- ifsrrtm/srtm_taumol17.F90 | 20 +- ifsrrtm/srtm_taumol18.F90 | 9 + ifsrrtm/srtm_taumol19.F90 | 9 + ifsrrtm/srtm_taumol20.F90 | 9 + ifsrrtm/srtm_taumol21.F90 | 9 + ifsrrtm/srtm_taumol22.F90 | 9 + ifsrrtm/srtm_taumol23.F90 | 9 + ifsrrtm/srtm_taumol24.F90 | 9 + ifsrrtm/srtm_taumol25.F90 | 9 + ifsrrtm/srtm_taumol26.F90 | 9 + ifsrrtm/srtm_taumol27.F90 | 22 +- ifsrrtm/srtm_taumol28.F90 | 26 +- ifsrrtm/srtm_taumol29.F90 | 21 +- ifsrrtm/surdi.F90 | 2 +- ifsrrtm/surrtab.F90 | 9 + ifsrrtm/surrtftr.F90 | 9 + ifsrrtm/surrtpk.F90 | 9 + ifsrrtm/surrtrf.F90 | 9 + ifsrrtm/susrtm.F90 | 9 + ifsrrtm/yoerdi.F90 | 13 +- ifsrrtm/yoerrta1.F90 | 11 +- ifsrrtm/yoerrta10.F90 | 11 +- ifsrrtm/yoerrta11.F90 | 11 +- ifsrrtm/yoerrta12.F90 | 11 +- ifsrrtm/yoerrta13.F90 | 11 +- ifsrrtm/yoerrta14.F90 | 11 +- ifsrrtm/yoerrta15.F90 | 11 +- ifsrrtm/yoerrta16.F90 | 11 +- ifsrrtm/yoerrta2.F90 | 11 +- ifsrrtm/yoerrta3.F90 | 11 +- ifsrrtm/yoerrta4.F90 | 11 +- ifsrrtm/yoerrta5.F90 | 11 +- ifsrrtm/yoerrta6.F90 | 11 +- ifsrrtm/yoerrta7.F90 | 11 +- ifsrrtm/yoerrta8.F90 | 11 +- ifsrrtm/yoerrta9.F90 | 11 +- ifsrrtm/yoerrtab.F90 | 11 +- ifsrrtm/yoerrtbg2.F90 | 11 +- ifsrrtm/yoerrtftr.F90 | 11 +- ifsrrtm/yoerrtm.F90 | 11 +- ifsrrtm/yoerrto1.F90 | 13 +- ifsrrtm/yoerrto10.F90 | 14 +- ifsrrtm/yoerrto11.F90 | 14 +- ifsrrtm/yoerrto12.F90 | 14 +- ifsrrtm/yoerrto13.F90 | 14 +- ifsrrtm/yoerrto14.F90 | 14 +- ifsrrtm/yoerrto15.F90 | 14 +- ifsrrtm/yoerrto16.F90 | 14 +- ifsrrtm/yoerrto2.F90 | 14 +- ifsrrtm/yoerrto3.F90 | 14 +- ifsrrtm/yoerrto4.F90 | 14 +- ifsrrtm/yoerrto5.F90 | 14 +- ifsrrtm/yoerrto6.F90 | 14 +- ifsrrtm/yoerrto7.F90 | 14 +- ifsrrtm/yoerrto8.F90 | 14 +- ifsrrtm/yoerrto9.F90 | 14 +- ifsrrtm/yoerrtrf.F90 | 11 +- ifsrrtm/yoerrtrwt.F90 | 11 +- ifsrrtm/yoerrtwn.F90 | 11 +- ifsrrtm/yoesrta16.F90 | 14 +- ifsrrtm/yoesrta17.F90 | 14 +- ifsrrtm/yoesrta18.F90 | 14 +- ifsrrtm/yoesrta19.F90 | 14 +- ifsrrtm/yoesrta20.F90 | 14 +- ifsrrtm/yoesrta21.F90 | 17 +- ifsrrtm/yoesrta22.F90 | 14 +- ifsrrtm/yoesrta23.F90 | 14 +- ifsrrtm/yoesrta24.F90 | 14 +- ifsrrtm/yoesrta25.F90 | 14 +- ifsrrtm/yoesrta26.F90 | 11 +- ifsrrtm/yoesrta27.F90 | 14 +- ifsrrtm/yoesrta28.F90 | 14 +- ifsrrtm/yoesrta29.F90 | 14 +- ifsrrtm/yoesrtab.F90 | 9 + ifsrrtm/yoesrtaer.F90 | 9 + ifsrrtm/yoesrtm.F90 | 11 +- ifsrrtm/yoesrtwn.F90 | 11 +- ifsrrtm/yoesw.F90 | 11 + radiation/radiation_aerosol_optics.F90 | 361 +++++++------ radiation/radiation_aerosol_optics_data.F90 | 38 +- .../radiation_aerosol_optics_description.F90 | 9 +- radiation/radiation_cloud.F90 | 104 +--- radiation/radiation_cloud_cover.F90 | 28 +- radiation/radiation_cloud_generator.F90 | 192 +++---- radiation/radiation_cloud_optics.F90 | 449 ++++++++-------- radiation/radiation_cloud_optics_data.F90 | 13 +- radiation/radiation_cloudless_lw.F90 | 12 +- radiation/radiation_cloudless_sw.F90 | 12 +- radiation/radiation_config.F90 | 223 +++----- radiation/radiation_ecckd.F90 | 286 +--------- radiation/radiation_ecckd_gas.F90 | 6 - radiation/radiation_ecckd_interface.F90 | 78 +-- radiation/radiation_flux.F90 | 4 +- radiation/radiation_gas.F90 | 102 ++-- radiation/radiation_general_cloud_optics.F90 | 54 +- .../radiation_general_cloud_optics_data.F90 | 116 +---- radiation/radiation_ice_optics_baran2016.F90 | 10 +- radiation/radiation_ice_optics_baran2017.F90 | 10 +- radiation/radiation_ice_optics_yi.F90 | 12 +- radiation/radiation_ifs_rrtm.F90 | 493 ++++++++---------- radiation/radiation_interface.F90 | 67 +-- radiation/radiation_liquid_optics_slingo.F90 | 4 +- radiation/radiation_mcica_lw.F90 | 95 +--- radiation/radiation_mcica_sw.F90 | 200 +++---- radiation/radiation_pdf_sampler.F90 | 18 +- radiation/radiation_save.F90 | 10 +- radiation/radiation_spectral_definition.F90 | 113 +--- radiation/radiation_thermodynamics.F90 | 20 +- radiation/radiation_tripleclouds_lw.F90 | 61 +-- radiation/radiation_tripleclouds_sw.F90 | 95 ++-- radiation/radiation_two_stream.F90 | 173 ++---- utilities/easy_netcdf.F90 | 291 +---------- utilities/easy_netcdf_read_mpi.F90 | 210 +------- utilities/radiation_io.F90 | 26 +- 202 files changed, 3582 insertions(+), 3701 deletions(-) diff --git a/.gitignore b/.gitignore index 265fa351..99e8b274 100644 --- a/.gitignore +++ b/.gitignore @@ -8,3 +8,4 @@ mod practical/data practical/ecrad /build* +.vimgit/* diff --git a/ifs/radiation_setup.F90 b/ifs/radiation_setup.F90 index 8f103323..99f27e3b 100644 --- a/ifs/radiation_setup.F90 +++ b/ifs/radiation_setup.F90 @@ -236,8 +236,7 @@ SUBROUTINE SETUP_RADIATION_SCHEME(PRADIATION,LDOUTPUT,FILE_NAME) ENDIF ELSEIF (YDERAD%NICEOPT == 4) THEN RAD_CONFIG%I_ICE_MODEL = IICEMODELBARAN - IF (RAD_CONFIG%I_GAS_MODEL_SW == IGasModelECCKD & - .OR. RAD_CONFIG%I_GAS_MODEL_LW == IGasModelECCKD) THEN + IF (RAD_CONFIG%I_GAS_MODEL == IGasModelECCKD) THEN WRITE(NULERR,'(a,i0)') '*** Error: Baran ice optics unavailable with generalized cloud optics' CALL ABOR1('RADIATION_SETUP: error interpreting NICEOPT') ENDIF @@ -521,7 +520,7 @@ SUBROUTINE SETUP_RADIATION_SCHEME(PRADIATION,LDOUTPUT,FILE_NAME) ! Do we scale the incoming solar radiation in each band? IF (YDERAD%NSOLARSPECTRUM > 0 & - & .AND. RAD_CONFIG%I_GAS_MODEL_SW == IGasModelIFSRRTMG) THEN + & .AND. RAD_CONFIG%I_GAS_MODEL == IGasModelIFSRRTMG) THEN IF (RAD_CONFIG%N_BANDS_SW /= 14) THEN WRITE(NULERR,'(a,i0,a)') '*** Error: ', RAD_CONFIG%N_BANDS_SW, & & ' shortwave bands but need 14 to apply spectral scaling' diff --git a/ifsrrtm/parrrtm.F90 b/ifsrrtm/parrrtm.F90 index 8a6a2199..7b79f987 100644 --- a/ifsrrtm/parrrtm.F90 +++ b/ifsrrtm/parrrtm.F90 @@ -1,11 +1,18 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE PARRRTM USE PARKIND1 ,ONLY : JPIM IMPLICIT NONE -PUBLIC - SAVE ! ------------------------------------------------------------------ diff --git a/ifsrrtm/parsrtm.F90 b/ifsrrtm/parsrtm.F90 index 8dfe8674..a7e9c587 100644 --- a/ifsrrtm/parsrtm.F90 +++ b/ifsrrtm/parsrtm.F90 @@ -1,11 +1,18 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE PARSRTM USE PARKIND1 ,ONLY : JPIM IMPLICIT NONE -PUBLIC - SAVE ! ------------------------------------------------------------------ diff --git a/ifsrrtm/rrtm_cmbgb1.F90 b/ifsrrtm/rrtm_cmbgb1.F90 index cc16f2fd..8bf907f9 100644 --- a/ifsrrtm/rrtm_cmbgb1.F90 +++ b/ifsrrtm/rrtm_cmbgb1.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! !*************************************************************************** SUBROUTINE RRTM_CMBGB1 !*************************************************************************** diff --git a/ifsrrtm/rrtm_cmbgb10.F90 b/ifsrrtm/rrtm_cmbgb10.F90 index 53551fd6..94394781 100644 --- a/ifsrrtm/rrtm_cmbgb10.F90 +++ b/ifsrrtm/rrtm_cmbgb10.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! !*************************************************************************** SUBROUTINE RRTM_CMBGB10 !*************************************************************************** diff --git a/ifsrrtm/rrtm_cmbgb11.F90 b/ifsrrtm/rrtm_cmbgb11.F90 index 3f0404ed..12b17a25 100644 --- a/ifsrrtm/rrtm_cmbgb11.F90 +++ b/ifsrrtm/rrtm_cmbgb11.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! !*************************************************************************** SUBROUTINE RRTM_CMBGB11 !*************************************************************************** diff --git a/ifsrrtm/rrtm_cmbgb12.F90 b/ifsrrtm/rrtm_cmbgb12.F90 index 418d8460..3b53fdd4 100644 --- a/ifsrrtm/rrtm_cmbgb12.F90 +++ b/ifsrrtm/rrtm_cmbgb12.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! !*************************************************************************** SUBROUTINE RRTM_CMBGB12 !*************************************************************************** diff --git a/ifsrrtm/rrtm_cmbgb13.F90 b/ifsrrtm/rrtm_cmbgb13.F90 index e62b8e0d..ec39af46 100644 --- a/ifsrrtm/rrtm_cmbgb13.F90 +++ b/ifsrrtm/rrtm_cmbgb13.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! !*************************************************************************** SUBROUTINE RRTM_CMBGB13 !*************************************************************************** diff --git a/ifsrrtm/rrtm_cmbgb14.F90 b/ifsrrtm/rrtm_cmbgb14.F90 index 480e0f1a..5862998f 100644 --- a/ifsrrtm/rrtm_cmbgb14.F90 +++ b/ifsrrtm/rrtm_cmbgb14.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! !*************************************************************************** SUBROUTINE RRTM_CMBGB14 !*************************************************************************** diff --git a/ifsrrtm/rrtm_cmbgb15.F90 b/ifsrrtm/rrtm_cmbgb15.F90 index 8b88c4de..e7d629c9 100644 --- a/ifsrrtm/rrtm_cmbgb15.F90 +++ b/ifsrrtm/rrtm_cmbgb15.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! !*************************************************************************** SUBROUTINE RRTM_CMBGB15 !*************************************************************************** diff --git a/ifsrrtm/rrtm_cmbgb16.F90 b/ifsrrtm/rrtm_cmbgb16.F90 index 9e030425..1b038037 100644 --- a/ifsrrtm/rrtm_cmbgb16.F90 +++ b/ifsrrtm/rrtm_cmbgb16.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! !*************************************************************************** SUBROUTINE RRTM_CMBGB16 !*************************************************************************** diff --git a/ifsrrtm/rrtm_cmbgb2.F90 b/ifsrrtm/rrtm_cmbgb2.F90 index 5207b1ba..ea58b20e 100644 --- a/ifsrrtm/rrtm_cmbgb2.F90 +++ b/ifsrrtm/rrtm_cmbgb2.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! !*************************************************************************** SUBROUTINE RRTM_CMBGB2 !*************************************************************************** diff --git a/ifsrrtm/rrtm_cmbgb3.F90 b/ifsrrtm/rrtm_cmbgb3.F90 index b6ce80e2..32034d6f 100644 --- a/ifsrrtm/rrtm_cmbgb3.F90 +++ b/ifsrrtm/rrtm_cmbgb3.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! !*************************************************************************** SUBROUTINE RRTM_CMBGB3 !*************************************************************************** diff --git a/ifsrrtm/rrtm_cmbgb4.F90 b/ifsrrtm/rrtm_cmbgb4.F90 index 25f159cb..b2f6c33b 100644 --- a/ifsrrtm/rrtm_cmbgb4.F90 +++ b/ifsrrtm/rrtm_cmbgb4.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! !*************************************************************************** SUBROUTINE RRTM_CMBGB4 !*************************************************************************** diff --git a/ifsrrtm/rrtm_cmbgb5.F90 b/ifsrrtm/rrtm_cmbgb5.F90 index c7df8bb3..43d4f48a 100644 --- a/ifsrrtm/rrtm_cmbgb5.F90 +++ b/ifsrrtm/rrtm_cmbgb5.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! !*************************************************************************** SUBROUTINE RRTM_CMBGB5 !*************************************************************************** diff --git a/ifsrrtm/rrtm_cmbgb6.F90 b/ifsrrtm/rrtm_cmbgb6.F90 index df6acd36..75a5f1b4 100644 --- a/ifsrrtm/rrtm_cmbgb6.F90 +++ b/ifsrrtm/rrtm_cmbgb6.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! !*************************************************************************** SUBROUTINE RRTM_CMBGB6 !*************************************************************************** diff --git a/ifsrrtm/rrtm_cmbgb7.F90 b/ifsrrtm/rrtm_cmbgb7.F90 index 0d6cda02..f4c57369 100644 --- a/ifsrrtm/rrtm_cmbgb7.F90 +++ b/ifsrrtm/rrtm_cmbgb7.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! !*************************************************************************** SUBROUTINE RRTM_CMBGB7 !*************************************************************************** diff --git a/ifsrrtm/rrtm_cmbgb8.F90 b/ifsrrtm/rrtm_cmbgb8.F90 index 1cbc71a2..f324f849 100644 --- a/ifsrrtm/rrtm_cmbgb8.F90 +++ b/ifsrrtm/rrtm_cmbgb8.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! !*************************************************************************** SUBROUTINE RRTM_CMBGB8 !*************************************************************************** diff --git a/ifsrrtm/rrtm_cmbgb9.F90 b/ifsrrtm/rrtm_cmbgb9.F90 index c5d71243..f0b80d54 100644 --- a/ifsrrtm/rrtm_cmbgb9.F90 +++ b/ifsrrtm/rrtm_cmbgb9.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! !*************************************************************************** SUBROUTINE RRTM_CMBGB9 !*************************************************************************** diff --git a/ifsrrtm/rrtm_gas_optical_depth.F90 b/ifsrrtm/rrtm_gas_optical_depth.F90 index bc328213..9526615b 100644 --- a/ifsrrtm/rrtm_gas_optical_depth.F90 +++ b/ifsrrtm/rrtm_gas_optical_depth.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! !option! -pvctl no_on_adb !option! -pvctl nocollapse SUBROUTINE RRTM_GAS_OPTICAL_DEPTH(KIDIA,KFDIA,KLEV,POD,PAVEL, PCOLDRY,PCOLBRD,PWX,& diff --git a/ifsrrtm/rrtm_init_140gp.F90 b/ifsrrtm/rrtm_init_140gp.F90 index 71958c0d..70664d62 100644 --- a/ifsrrtm/rrtm_init_140gp.F90 +++ b/ifsrrtm/rrtm_init_140gp.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! !*************************************************************************** SUBROUTINE RRTM_INIT_140GP(CDIRECTORY) !*************************************************************************** @@ -11,7 +20,7 @@ SUBROUTINE RRTM_INIT_140GP(CDIRECTORY) USE PARRRTM , ONLY : JPBAND ,JPG USE YOERRTM , ONLY : JPGPT -USE YOERRTWN , ONLY : NG +USE YOERRTWN , ONLY : NG USE YOERRTFTR, ONLY : NGC ,NGN ,NGM , WT ! Output USE YOERRTBG2, ONLY : CORR1 ,CORR2 diff --git a/ifsrrtm/rrtm_kgb1.F90 b/ifsrrtm/rrtm_kgb1.F90 index 0697b2c2..ec99300d 100644 --- a/ifsrrtm/rrtm_kgb1.F90 +++ b/ifsrrtm/rrtm_kgb1.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE RRTM_KGB1(CDIRECTORY) ! Originally by Eli J. Mlawer, Atmospheric & Environmental Research. @@ -16,7 +25,7 @@ SUBROUTINE RRTM_KGB1(CDIRECTORY) USE YOMLUN_ECRAD,ONLY : NULRAD, NULOUT USE MPL_MODULE,ONLY : MPL_BROADCAST USE YOMTAG ,ONLY : MTAGRAD -USE YOMMP0_IFSAUX ,ONLY : NPROC, MYPROC +USE YOMMP0_IFSAUX,ONLY : NPROC, MYPROC USE YOERRTO1 , ONLY : KAO ,KBO ,SELFREFO ,FRACREFAO ,& & FRACREFBO ,FORREFO, KAO_MN2, KBO_MN2, KAO_D, KBO_D @@ -38,7 +47,11 @@ SUBROUTINE RRTM_KGB1(CDIRECTORY) IF( MYPROC==1 )THEN CLF1 = TRIM(CDIRECTORY) // "/RADRRTM" WRITE(NULOUT,'(a,a)') 'Reading RRTMG longwave data file ', TRIM(CLF1) +#ifdef LITTLE_ENDIAN OPEN(NULRAD,FILE=TRIM(CLF1),FORM="UNFORMATTED",ACTION="READ",ERR=1000,CONVERT='BIG_ENDIAN') +#else + OPEN(NULRAD,FILE=TRIM(CLF1),FORM="UNFORMATTED",ACTION="READ",ERR=1000) +#endif READ(NULRAD,ERR=1001) KAO_D,KBO_D ! Convert the data into model actual precision. @@ -65,9 +78,9 @@ SUBROUTINE RRTM_KGB1(CDIRECTORY) & 1.9141E-03_JPRB,1.2612E-03_JPRB,5.3169E-04_JPRB,7.6476E-05_JPRB/) ! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index +! foreign-continuum (including the energy term). The first +! index refers to reference temperature (296,260,224,260) and +! pressure (970,475,219,3 mbar) levels. The second index ! runs over the g-channel (1 to 16). FORREFO(1,:) = (/ & @@ -90,27 +103,27 @@ SUBROUTINE RRTM_KGB1(CDIRECTORY) ! ------------------------------------------------------------------ -! The array KAO contains absorption coefs at the 16 chosen g-values +! The array KAO contains absorption coefs at the 16 chosen g-values ! for a range of pressure levels > ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the corresponding TREF for this pressure level, -! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, -! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second -! index, JP, runs from 1 to 13 and refers to the corresponding -! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb). -! The third index, IG, goes from 1 to 16, and tells us which +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the corresponding TREF for this pressure level, +! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, +! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second +! index, JP, runs from 1 to 13 and refers to the corresponding +! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb). +! The third index, IG, goes from 1 to 16, and tells us which ! g-interval the absorption coefficients are for. -! The array KBO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure +! The array KBO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure ! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. ! The second index, JP, runs from 13 to 59 and refers to the JPth ! reference pressure level (see taumol.f for the value of these ! pressure levels in mb). The third index, IG, goes from 1 to 16, @@ -336,6 +349,8 @@ SUBROUTINE RRTM_KGB1(CDIRECTORY) & 3.85223E+00_JPRB, 3.34122E+00_JPRB, 2.89800E+00_JPRB, 2.51357E+00_JPRB, 2.18014E+00_JPRB/) + + IF (LHOOK) CALL DR_HOOK('RRTM_KGB1',1,ZHOOK_HANDLE) RETURN diff --git a/ifsrrtm/rrtm_kgb10.F90 b/ifsrrtm/rrtm_kgb10.F90 index b2ec8d67..b853e165 100644 --- a/ifsrrtm/rrtm_kgb10.F90 +++ b/ifsrrtm/rrtm_kgb10.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE RRTM_KGB10 ! Originally by Eli J. Mlawer, Atmospheric & Environmental Research. @@ -13,7 +22,7 @@ SUBROUTINE RRTM_KGB10 USE PARKIND1 ,ONLY : JPRB USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK USE YOMLUN_ECRAD,ONLY : NULRAD -USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC +USE YOMMP0_IFSAUX,ONLY : NPROC, MYPROC USE MPL_MODULE,ONLY : MPL_BROADCAST USE YOMTAG ,ONLY : MTAGRAD @@ -56,27 +65,27 @@ SUBROUTINE RRTM_KGB10 ! ------------------------------------------------------------------ -! The array KAO contains absorption coefs at the 16 chosen g-values +! The array KAO contains absorption coefs at the 16 chosen g-values ! for a range of pressure levels > ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the corresponding TREF for this pressure level, -! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, -! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second -! index, JP, runs from 1 to 13 and refers to the corresponding -! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb). -! The third index, IG, goes from 1 to 16, and tells us which +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the corresponding TREF for this pressure level, +! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, +! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second +! index, JP, runs from 1 to 13 and refers to the corresponding +! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb). +! The third index, IG, goes from 1 to 16, and tells us which ! g-interval the absorption coefficients are for. -! The array KBO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure +! The array KBO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure ! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. ! The second index, JP, runs from 13 to 59 and refers to the JPth ! reference pressure level (see taumol.f for the value of these ! pressure levels in mb). The third index, IG, goes from 1 to 16, @@ -84,9 +93,9 @@ SUBROUTINE RRTM_KGB10 ! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index +! foreign-continuum (including the energy term). The first +! index refers to reference temperature (296,260,224,260) and +! pressure (970,475,219,3 mbar) levels. The second index ! runs over the g-channel (1 to 16). FORREFO(1,:) = (/ & diff --git a/ifsrrtm/rrtm_kgb11.F90 b/ifsrrtm/rrtm_kgb11.F90 index d68899a9..c3d4c7a1 100644 --- a/ifsrrtm/rrtm_kgb11.F90 +++ b/ifsrrtm/rrtm_kgb11.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE RRTM_KGB11 ! Originally by Eli J. Mlawer, Atmospheric & Environmental Research. @@ -13,7 +22,7 @@ SUBROUTINE RRTM_KGB11 USE PARKIND1 ,ONLY : JPRB USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK USE YOMLUN_ECRAD,ONLY : NULRAD -USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC +USE YOMMP0_IFSAUX,ONLY : NPROC, MYPROC USE MPL_MODULE,ONLY : MPL_BROADCAST USE YOMTAG ,ONLY : MTAGRAD @@ -53,38 +62,38 @@ SUBROUTINE RRTM_KGB11 ! ------------------------------------------------------------------ -! The array KA contains absorption coefs at the 16 chosen g-values +! The array KA contains absorption coefs at the 16 chosen g-values ! for a range of pressure levels > ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the corresponding TREF for this pressure level, -! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, -! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second -! index, JP, runs from 1 to 13 and refers to the corresponding -! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb). -! The third index, IG, goes from 1 to 16, and tells us which +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the corresponding TREF for this pressure level, +! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, +! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second +! index, JP, runs from 1 to 13 and refers to the corresponding +! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb). +! The third index, IG, goes from 1 to 16, and tells us which ! g-interval the absorption coefficients are for. -! The array KB contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure +! The array KB contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure ! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. ! The second index, JP, runs from 13 to 59 and refers to the JPth ! reference pressure level (see taumol.f for the value of these ! pressure levels in mb). The third index, IG, goes from 1 to 16, ! and tells us which g-interval the absorption coefficients are for. -! The array KAO_Mxx contains the absorption coefficient for +! The array KAO_Mxx contains the absorption coefficient for ! a minor species at the 16 chosen g-values for a reference pressure -! level below 100~ mb. The first index refers to temperature -! in 7.2 degree increments. For instance, JT = 1 refers to a -! temperature of 188.0, JT = 2 refers to 195.2, etc. The second index +! level below 100~ mb. The first index refers to temperature +! in 7.2 degree increments. For instance, JT = 1 refers to a +! temperature of 188.0, JT = 2 refers to 195.2, etc. The second index ! runs over the g-channel (1 to 16). KAO_MO2(:, 1) = (/ & @@ -168,11 +177,11 @@ SUBROUTINE RRTM_KGB11 & 8.03352E-07_JPRB, 8.27282E-07_JPRB, 8.51925E-07_JPRB, 8.77302E-07_JPRB, 9.03435E-07_JPRB, & & 9.30347E-07_JPRB, 9.58060E-07_JPRB, 9.86599E-07_JPRB, 1.01599E-06_JPRB/) -! The array KBO_Mxx contains the absorption coefficient for +! The array KBO_Mxx contains the absorption coefficient for ! a minor species at the 16 chosen g-values for a reference pressure -! level above 100~ mb. The first index refers to temperature -! in 7.2 degree increments. For instance, JT = 1 refers to a -! temperature of 188.0, JT = 2 refers to 195.2, etc. The second index +! level above 100~ mb. The first index refers to temperature +! in 7.2 degree increments. For instance, JT = 1 refers to a +! temperature of 188.0, JT = 2 refers to 195.2, etc. The second index ! runs over the g-channel (1 to 16). KBO_MO2(:, 1) = (/ & @@ -257,9 +266,9 @@ SUBROUTINE RRTM_KGB11 & 2.74161E-06_JPRB, 2.71844E-06_JPRB, 2.69547E-06_JPRB, 2.67269E-06_JPRB/) ! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index +! foreign-continuum (including the energy term). The first +! index refers to reference temperature (296,260,224,260) and +! pressure (970,475,219,3 mbar) levels. The second index ! runs over the g-channel (1 to 16). FORREFO(1,:) = (/ & diff --git a/ifsrrtm/rrtm_kgb12.F90 b/ifsrrtm/rrtm_kgb12.F90 index 8c1ae575..fa48d61c 100644 --- a/ifsrrtm/rrtm_kgb12.F90 +++ b/ifsrrtm/rrtm_kgb12.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE RRTM_KGB12 ! Originally by Eli J. Mlawer, Atmospheric & Environmental Research. @@ -12,7 +21,7 @@ SUBROUTINE RRTM_KGB12 USE PARKIND1 ,ONLY : JPRB USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK USE YOMLUN_ECRAD,ONLY : NULRAD -USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC +USE YOMMP0_IFSAUX,ONLY : NPROC, MYPROC USE MPL_MODULE,ONLY : MPL_BROADCAST USE YOMTAG ,ONLY : MTAGRAD @@ -77,12 +86,12 @@ SUBROUTINE RRTM_KGB12 ! ------------------------------------------------------------------ -! The array KAO contains absorption coefs at the 16 chosen g-values +! The array KAO contains absorption coefs at the 16 chosen g-values ! for a range of pressure levels> ~100mb, temperatures, and binary -! species parameters (see taumol.f for definition). The first -! index in the array, JS, runs from 1 to 9, and corresponds to -! different values of the binary species parameter. For instance, -! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, +! species parameters (see taumol.f for definition). The first +! index in the array, JS, runs from 1 to 9, and corresponds to +! different values of the binary species parameter. For instance, +! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, ! JS = 3 corresponds to the parameter value 2/8, etc. The second index ! in the array, JT, which runs from 1 to 5, corresponds to different ! temperatures. More specifically, JT = 3 means that the data are for @@ -95,9 +104,9 @@ SUBROUTINE RRTM_KGB12 ! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index +! foreign-continuum (including the energy term). The first +! index refers to reference temperature (296,260,224,260) and +! pressure (970,475,219,3 mbar) levels. The second index ! runs over the g-channel (1 to 16). FORREFO(1,:) = (/ & diff --git a/ifsrrtm/rrtm_kgb13.F90 b/ifsrrtm/rrtm_kgb13.F90 index 5e0bfce9..7a8df40e 100644 --- a/ifsrrtm/rrtm_kgb13.F90 +++ b/ifsrrtm/rrtm_kgb13.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE RRTM_KGB13 ! Originally by Eli J. Mlawer, Atmospheric & Environmental Research. @@ -13,7 +22,7 @@ SUBROUTINE RRTM_KGB13 USE PARKIND1 ,ONLY : JPRB USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK USE YOMLUN_ECRAD,ONLY : NULRAD -USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC +USE YOMMP0_IFSAUX,ONLY : NPROC, MYPROC USE MPL_MODULE,ONLY : MPL_BROADCAST USE YOMTAG ,ONLY : MTAGRAD @@ -37,7 +46,7 @@ SUBROUTINE RRTM_KGB13 CALL MPL_BROADCAST (KAO,MTAGRAD,1,CDSTRING='RRTM_KGB13:') ENDIF -! Planck fraction mapping level : P=473.4280 mb, T = 259.83 K +! Planck fraction mapping level : P=473.4280 mb, T = 259.83 K FRACREFAO(:, 1) = (/ & & 1.7534E-01_JPRB,1.7394E-01_JPRB,1.6089E-01_JPRB,1.3782E-01_JPRB,1.0696E-01_JPRB,8.5853E-02_JPRB, & & 6.6548E-02_JPRB,4.9053E-02_JPRB,3.2064E-02_JPRB,3.4820E-03_JPRB,2.8763E-03_JPRB,2.2204E-03_JPRB, & @@ -84,12 +93,12 @@ SUBROUTINE RRTM_KGB13 ! ------------------------------------------------------------------ -! The array KAO contains absorption coefs at the 16 chosen g-values +! The array KAO contains absorption coefs at the 16 chosen g-values ! for a range of pressure levels> ~100mb, temperatures, and binary -! species parameters (see taumol.f for definition). The first -! index in the array, JS, runs from 1 to 9, and corresponds to -! different values of the binary species parameter. For instance, -! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, +! species parameters (see taumol.f for definition). The first +! index in the array, JS, runs from 1 to 9, and corresponds to +! different values of the binary species parameter. For instance, +! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, ! JS = 3 corresponds to the parameter value 2/8, etc. The second index ! in the array, JT, which runs from 1 to 5, corresponds to different ! temperatures. More specifically, JT = 3 means that the data are for @@ -101,16 +110,16 @@ SUBROUTINE RRTM_KGB13 ! which g-interval the absorption coefficients are for. -! The array KAO_Mxx contains the absorption coefficient for +! The array KAO_Mxx contains the absorption coefficient for ! a minor species at the 16 chosen g-values for a reference pressure ! level below 100~ mb. The first index in the array, JS, runs ! from 1 to 10, and corresponds to different gas column amount ratios, ! as expressed through the binary species parameter eta, defined as -! eta = gas1/(gas1 + (rat) * gas2), where rat is the -! ratio of the reference MLS column amount value of gas 1 -! to that of gas2. The second index refers to temperature -! in 7.2 degree increments. For instance, JT = 1 refers to a -! temperature of 188.0, JT = 2 refers to 195.2, etc. The third index +! eta = gas1/(gas1 + (rat) * gas2), where rat is the +! ratio of the reference MLS column amount value of gas 1 +! to that of gas2. The second index refers to temperature +! in 7.2 degree increments. For instance, JT = 1 refers to a +! temperature of 188.0, JT = 2 refers to 195.2, etc. The third index ! runs over the g-channel (1 to 16). KAO_MCO2( 1, :, 1) = (/ & @@ -1555,11 +1564,11 @@ SUBROUTINE RRTM_KGB13 & 1.05699E+00_JPRB, 1.06158E+00_JPRB, 1.06619E+00_JPRB, 1.07081E+00_JPRB, 1.07546E+00_JPRB, & & 1.08012E+00_JPRB, 1.08481E+00_JPRB, 1.08952E+00_JPRB, 1.09425E+00_JPRB/) -! The array KBO_Mxx contains the absorption coefficient for +! The array KBO_Mxx contains the absorption coefficient for ! a minor species at the 16 chosen g-values for a reference pressure -! level above 100~ mb. The first index refers to temperature -! in 7.2 degree increments. For instance, JT = 1 refers to a -! temperature of 188.0, JT = 2 refers to 195.2, etc. The second index +! level above 100~ mb. The first index refers to temperature +! in 7.2 degree increments. For instance, JT = 1 refers to a +! temperature of 188.0, JT = 2 refers to 195.2, etc. The second index ! runs over the g-channel (1 to 16). KBO_MO3(:, 1) = (/ & @@ -1644,9 +1653,9 @@ SUBROUTINE RRTM_KGB13 & 1.87700E-03_JPRB, 1.87816E-03_JPRB, 1.87932E-03_JPRB, 1.88049E-03_JPRB/) ! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index +! foreign-continuum (including the energy term). The first +! index refers to reference temperature (296,260,224,260) and +! pressure (970,475,219,3 mbar) levels. The second index ! runs over the g-channel (1 to 16). FORREFO(1,:) = (/ & diff --git a/ifsrrtm/rrtm_kgb14.F90 b/ifsrrtm/rrtm_kgb14.F90 index 1f3ba30d..ca150bf8 100644 --- a/ifsrrtm/rrtm_kgb14.F90 +++ b/ifsrrtm/rrtm_kgb14.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE RRTM_KGB14 ! Originally by Eli J. Mlawer, Atmospheric & Environmental Research. @@ -13,7 +22,7 @@ SUBROUTINE RRTM_KGB14 USE PARKIND1 ,ONLY : JPRB USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK USE YOMLUN_ECRAD,ONLY : NULRAD -USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC +USE YOMMP0_IFSAUX,ONLY : NPROC, MYPROC USE MPL_MODULE,ONLY : MPL_BROADCAST USE YOMTAG ,ONLY : MTAGRAD @@ -55,27 +64,27 @@ SUBROUTINE RRTM_KGB14 ! ------------------------------------------------------------------ -! The array KAO contains absorption coefs at the 16 chosen g-values +! The array KAO contains absorption coefs at the 16 chosen g-values ! for a range of pressure levels > ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the corresponding TREF for this pressure level, -! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, -! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second -! index, JP, runs from 1 to 13 and refers to the corresponding -! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb). -! The third index, IG, goes from 1 to 16, and tells us which +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the corresponding TREF for this pressure level, +! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, +! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second +! index, JP, runs from 1 to 13 and refers to the corresponding +! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb). +! The third index, IG, goes from 1 to 16, and tells us which ! g-interval the absorption coefficients are for. -! The array KBO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure +! The array KBO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure ! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. ! The second index, JP, runs from 13 to 59 and refers to the JPth ! reference pressure level (see taumol.f for the value of these ! pressure levels in mb). The third index, IG, goes from 1 to 16, @@ -83,9 +92,9 @@ SUBROUTINE RRTM_KGB14 ! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index +! foreign-continuum (including the energy term). The first +! index refers to reference temperature (296,260,224,260) and +! pressure (970,475,219,3 mbar) levels. The second index ! runs over the g-channel (1 to 16). FORREFO(1,:) = (/ & diff --git a/ifsrrtm/rrtm_kgb15.F90 b/ifsrrtm/rrtm_kgb15.F90 index f124fc7f..5a6d1236 100644 --- a/ifsrrtm/rrtm_kgb15.F90 +++ b/ifsrrtm/rrtm_kgb15.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE RRTM_KGB15 ! Originally by Eli J. Mlawer, Atmospheric & Environmental Research. @@ -17,7 +26,7 @@ SUBROUTINE RRTM_KGB15 USE YOMLUN_ECRAD,ONLY : NULRAD USE MPL_MODULE,ONLY : MPL_BROADCAST USE YOMTAG ,ONLY : MTAGRAD -USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC +USE YOMMP0_IFSAUX,ONLY : NPROC, MYPROC USE YOERRTO15, ONLY : KAO,KAO_MN2 ,SELFREFO,FORREFO ,FRACREFAO, KAO_D @@ -80,12 +89,12 @@ SUBROUTINE RRTM_KGB15 ! ------------------------------------------------------------------ -! The array KAO contains absorption coefs at the 16 chosen g-values +! The array KAO contains absorption coefs at the 16 chosen g-values ! for a range of pressure levels> ~100mb, temperatures, and binary -! species parameters (see taumol.f for definition). The first -! index in the array, JS, runs from 1 to 9, and corresponds to -! different values of the binary species parameter. For instance, -! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, +! species parameters (see taumol.f for definition). The first +! index in the array, JS, runs from 1 to 9, and corresponds to +! different values of the binary species parameter. For instance, +! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, ! JS = 3 corresponds to the parameter value 2/8, etc. The second index ! in the array, JT, which runs from 1 to 5, corresponds to different ! temperatures. More specifically, JT = 3 means that the data are for @@ -97,16 +106,16 @@ SUBROUTINE RRTM_KGB15 ! which g-interval the absorption coefficients are for. -! The array KA_Mxx contains the absorption coefficient for +! The array KA_Mxx contains the absorption coefficient for ! a minor species at the 16 chosen g-values for a reference pressure ! level below 100~ mb. The first index in the array, JS, runs ! from 1 to 10, and corresponds to different gas column amount ratios, ! as expressed through the binary species parameter eta, defined as -! eta = gas1/(gas1 + (rat) * gas2), where rat is the -! ratio of the reference MLS column amount value of gas 1 -! to that of gas2. The second index refers to temperature -! in 7.2 degree increments. For instance, JT = 1 refers to a -! temperature of 188.0, JT = 2 refers to 195.2, etc. The third index +! eta = gas1/(gas1 + (rat) * gas2), where rat is the +! ratio of the reference MLS column amount value of gas 1 +! to that of gas2. The second index refers to temperature +! in 7.2 degree increments. For instance, JT = 1 refers to a +! temperature of 188.0, JT = 2 refers to 195.2, etc. The third index ! runs over the g-channel (1 to 16). KAO_MN2( 1, :, 1) = (/ & @@ -831,9 +840,9 @@ SUBROUTINE RRTM_KGB15 & 1.30365E-06_JPRB, 1.27620E-06_JPRB, 1.24934E-06_JPRB, 1.22304E-06_JPRB/) ! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index +! foreign-continuum (including the energy term). The first +! index refers to reference temperature (296,260,224,260) and +! pressure (970,475,219,3 mbar) levels. The second index ! runs over the g-channel (1 to 16). FORREFO(1,:) = (/ & diff --git a/ifsrrtm/rrtm_kgb16.F90 b/ifsrrtm/rrtm_kgb16.F90 index 2f6febc4..b889fab3 100644 --- a/ifsrrtm/rrtm_kgb16.F90 +++ b/ifsrrtm/rrtm_kgb16.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE RRTM_KGB16 ! Originally by Eli J. Mlawer, Atmospheric & Environmental Research. @@ -17,7 +26,7 @@ SUBROUTINE RRTM_KGB16 USE YOMTAG ,ONLY : MTAGRAD USE YOERRTO16, ONLY : KAO,KBO ,SELFREFO,FORREFO ,FRACREFAO,FRACREFBO,KAO_D,KBO_D -USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC +USE YOMMP0_IFSAUX,ONLY : NPROC, MYPROC ! ------------------------------------------------------------------ @@ -87,12 +96,12 @@ SUBROUTINE RRTM_KGB16 ! ------------------------------------------------------------------ -! The array KAO contains absorption coefs at the 16 chosen g-values +! The array KAO contains absorption coefs at the 16 chosen g-values ! for a range of pressure levels> ~100mb, temperatures, and binary -! species parameters (see taumol.f for definition). The first -! index in the array, JS, runs from 1 to 9, and corresponds to -! different values of the binary species parameter. For instance, -! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, +! species parameters (see taumol.f for definition). The first +! index in the array, JS, runs from 1 to 9, and corresponds to +! different values of the binary species parameter. For instance, +! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, ! JS = 3 corresponds to the parameter value 2/8, etc. The second index ! in the array, JT, which runs from 1 to 5, corresponds to different ! temperatures. More specifically, JT = 3 means that the data are for @@ -104,13 +113,13 @@ SUBROUTINE RRTM_KGB16 ! which g-interval the absorption coefficients are for. -! The array KBO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure +! The array KBO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure ! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. ! The second index, JP, runs from 13 to 59 and refers to the JPth ! reference pressure level (see taumol.f for the value of these ! pressure levels in mb). The third index, IG, goes from 1 to 16, @@ -118,9 +127,9 @@ SUBROUTINE RRTM_KGB16 ! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index +! foreign-continuum (including the energy term). The first +! index refers to reference temperature (296,260,224,260) and +! pressure (970,475,219,3 mbar) levels. The second index ! runs over the g-channel (1 to 16). FORREFO(1,:) = (/ & diff --git a/ifsrrtm/rrtm_kgb2.F90 b/ifsrrtm/rrtm_kgb2.F90 index 4f968e49..ee24d1dd 100644 --- a/ifsrrtm/rrtm_kgb2.F90 +++ b/ifsrrtm/rrtm_kgb2.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE RRTM_KGB2 ! Originally by Eli J. Mlawer, Atmospheric & Environmental Research. @@ -6,7 +15,7 @@ SUBROUTINE RRTM_KGB2 ! R. Elkhatib 12-10-2005 Split for faster and more robust compilation. ! G.Mozdzynski March 2011 read constants from files ! ABozzo May 2013 update to RRTMG v4.85 -! band 2: 350-500 cm-1 +! band 2: 350-500 cm-1 ! T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring. ! F. Vana 05-Mar-2015 Support for single precision ! ------------------------------------------------------------------ @@ -19,7 +28,7 @@ SUBROUTINE RRTM_KGB2 USE YOERRTO2 , ONLY : KAO ,KBO ,SELFREFO ,FRACREFAO ,& & FRACREFBO ,FORREFO ,KAO_D, KBO_D -USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC +USE YOMMP0_IFSAUX,ONLY : NPROC, MYPROC ! ------------------------------------------------------------------ @@ -56,9 +65,9 @@ SUBROUTINE RRTM_KGB2 & 2.2359E-03_JPRB, 1.4226E-03_JPRB, 5.3642E-04_JPRB, 7.6316E-05_JPRB/) ! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index +! foreign-continuum (including the energy term). The first +! index refers to reference temperature (296,260,224,260) and +! pressure (970,475,219,3 mbar) levels. The second index ! runs over the g-channel (1 to 16). FORREFO(1,:) = (/ & @@ -85,31 +94,31 @@ SUBROUTINE RRTM_KGB2 !REFPARAM( :) = (/& ! & 0.903661_JPRB , 0.859386_JPRB , 0.746542_JPRB , 0.580496_JPRB , 0.412889_JPRB ,& ! & 0.275283_JPRB , 0.162745_JPRB , 7.63929E-02_JPRB, 1.82553E-02_JPRB, 3.72432E-03_JPRB, & -! & 2.14946E-03_JPRB, 1.66320E-03_JPRB, 1.59940E-03_JPRB/) +! & 2.14946E-03_JPRB, 1.66320E-03_JPRB, 1.59940E-03_JPRB/) ! ------------------------------------------------------------------ -! The array KAO contains absorption coefs at the 16 chosen g-values +! The array KAO contains absorption coefs at the 16 chosen g-values ! for a range of pressure levels > ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the corresponding TREF for this pressure level, -! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, -! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second -! index, JP, runs from 1 to 13 and refers to the corresponding -! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb). -! The third index, IG, goes from 1 to 16, and tells us which +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the corresponding TREF for this pressure level, +! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, +! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second +! index, JP, runs from 1 to 13 and refers to the corresponding +! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb). +! The third index, IG, goes from 1 to 16, and tells us which ! g-interval the absorption coefficients are for. -! The array KBO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure +! The array KBO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure ! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. ! The second index, JP, runs from 13 to 59 and refers to the JPth ! reference pressure level (see taumol.f for the value of these ! pressure levels in mb). The third index, IG, goes from 1 to 16, diff --git a/ifsrrtm/rrtm_kgb3.F90 b/ifsrrtm/rrtm_kgb3.F90 index 11968266..e320f045 100644 --- a/ifsrrtm/rrtm_kgb3.F90 +++ b/ifsrrtm/rrtm_kgb3.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE RRTM_KGB3 ! Originally by Eli J. Mlawer, Atmospheric & Environmental Research. @@ -7,7 +16,7 @@ SUBROUTINE RRTM_KGB3 ! G.Mozdzynski March 2011 read constants from files ! ABozzo 201305 updated to rrtmg_lw_v4.85: ! band 3: 500-630 cm-1 (low key - h2o,co2; low minor - n2o) -! (high key - h2o,co2; high minor - n2o) +! (high key - h2o,co2; high minor - n2o) ! T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring. ! F. Vana 05-Mar-2015 Support for single precision ! ------------------------------------------------------------------ @@ -17,12 +26,12 @@ SUBROUTINE RRTM_KGB3 USE YOMLUN_ECRAD,ONLY : NULRAD USE MPL_MODULE,ONLY : MPL_BROADCAST USE YOMTAG ,ONLY : MTAGRAD -USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC +USE YOMMP0_IFSAUX,ONLY : NPROC, MYPROC USE YOERRTO3 , ONLY : KAO ,KBO ,SELFREFO ,FRACREFAO ,& & FRACREFBO ,FORREFO ,KAO_MN2O,KBO_MN2O, KAO_D, KBO_D !USE YOERRTA3 , ONLY : ETAREF ,H2OREF ,& -! & N2OREF ,CO2REF ,STRRAT +! & N2OREF ,CO2REF ,STRRAT ! ------------------------------------------------------------------ @@ -115,9 +124,9 @@ SUBROUTINE RRTM_KGB3 ! eta = h2o/(h20 + (rat) * co2), where rat is the ratio of the integrated ! line strength in the band of co2 to that of h2o. For instance, ! JS=1 refers to dry air (eta = 0), JS = 10 corresponds to eta = 1.0. -! The 2nd index in the array, JT, which runs from 1 to 5, corresponds -! to different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure +! The 2nd index in the array, JT, which runs from 1 to 5, corresponds +! to different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure ! level, JT = 2 refers to the temperature ! TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 ! is for TREF+30. The third index, JP, runs from 1 to 13 and refers @@ -129,15 +138,15 @@ SUBROUTINE RRTM_KGB3 ! The array KBO contains absorption coefs for each of the 16 g-intervals ! for a range of pressure levels < ~100mb, temperatures, and ratios -! of H2O to CO2. The first index in the array, JS, runs from 1 to 5, -! and corresponds to different H2O to CO2 ratios, as expressed through -! the binary species parameter eta, defined as eta = H2O/(H2O+RAT*CO2), -! where RAT is the ratio of the integrated line strength in the band -! of CO2 to that of H2O. For instance, JS=1 refers to no H2O, +! of H2O to CO2. The first index in the array, JS, runs from 1 to 5, +! and corresponds to different H2O to CO2 ratios, as expressed through +! the binary species parameter eta, defined as eta = H2O/(H2O+RAT*CO2), +! where RAT is the ratio of the integrated line strength in the band +! of CO2 to that of H2O. For instance, JS=1 refers to no H2O, ! JS = 2 corresponds to eta = 0.25, etc. The second index, JT, which -! runs from 1 to 5, corresponds to different temperatures. More -! specifically, JT = 3 means that the data are for the corresponding -! reference temperature TREF for this pressure level, JT = 2 refers +! runs from 1 to 5, corresponds to different temperatures. More +! specifically, JT = 3 means that the data are for the corresponding +! reference temperature TREF for this pressure level, JT = 2 refers ! to the TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and ! JT = 5 is for TREF+30. The third index, JP, runs from 13 to 59 and ! refers to the corresponding pressure level in PREF (e.g. JP = 13 is @@ -145,16 +154,16 @@ SUBROUTINE RRTM_KGB3 ! 16, and tells us which g-interval the absorption coefficients are for. -! The array KAO_Mxx contains the absorption coefficient for +! The array KAO_Mxx contains the absorption coefficient for ! a minor species at the 16 chosen g-values for a reference pressure ! level below 100~ mb. The first index in the array, JS, runs ! from 1 to 10, and corresponds to different gas column amount ratios, ! as expressed through the binary species parameter eta, defined as -! eta = gas1/(gas1 + (rat) * gas2), where rat is the -! ratio of the reference MLS column amount value of gas 1 -! to that of gas2. The second index refers to temperature -! in 7.2 degree increments. For instance, JT = 1 refers to a -! temperature of 188.0, JT = 2 refers to 195.2, etc. The third index +! eta = gas1/(gas1 + (rat) * gas2), where rat is the +! ratio of the reference MLS column amount value of gas 1 +! to that of gas2. The second index refers to temperature +! in 7.2 degree increments. For instance, JT = 1 refers to a +! temperature of 188.0, JT = 2 refers to 195.2, etc. The third index ! runs over the g-channel (1 to 16). KAO_MN2O( 1, :, 1) = (/ & @@ -878,16 +887,16 @@ SUBROUTINE RRTM_KGB3 & 4.22310E-06_JPRB, 4.92480E-06_JPRB, 5.74308E-06_JPRB, 6.69733E-06_JPRB, 7.81013E-06_JPRB, & & 9.10784E-06_JPRB, 1.06212E-05_JPRB, 1.23859E-05_JPRB, 1.44439E-05_JPRB/) -! The array KBO_Mxx contains the absorption coefficient for +! The array KBO_Mxx contains the absorption coefficient for ! a minor species at the 16 chosen g-values for a reference pressure ! level above 100~ mb. The first index in the array, JS, runs ! from 1 to 10, and corresponds to different gas column amounts ratios, ! as expressed through the binary species parameter eta, defined as -! eta = gas1/(gas1 + (rat) * gas2), where rat is the -! ratio of the reference MLS column amount value of gas 1 to -! that of gas2. The second index refers to temperature -! in 7.2 degree increments. For instance, JT = 1 refers to a -! temperature of 188.0, JT = 2 refers to 195.2, etc. The third index +! eta = gas1/(gas1 + (rat) * gas2), where rat is the +! ratio of the reference MLS column amount value of gas 1 to +! that of gas2. The second index refers to temperature +! in 7.2 degree increments. For instance, JT = 1 refers to a +! temperature of 188.0, JT = 2 refers to 195.2, etc. The third index ! runs over the g-channel (1 to 16). KBO_MN2O( 1, :, 1) = (/ & @@ -1292,9 +1301,9 @@ SUBROUTINE RRTM_KGB3 & 1.60614E-06_JPRB, 2.03736E-06_JPRB, 2.58435E-06_JPRB, 3.27819E-06_JPRB/) ! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index +! foreign-continuum (including the energy term). The first +! index refers to reference temperature (296,260,224,260) and +! pressure (970,475,219,3 mbar) levels. The second index ! runs over the g-channel (1 to 16). FORREFO(1,:) = (/ & diff --git a/ifsrrtm/rrtm_kgb4.F90 b/ifsrrtm/rrtm_kgb4.F90 index 59ce73a9..78d0b202 100644 --- a/ifsrrtm/rrtm_kgb4.F90 +++ b/ifsrrtm/rrtm_kgb4.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE RRTM_KGB4 ! Originally by Eli J. Mlawer, Atmospheric & Environmental Research. @@ -15,7 +24,7 @@ SUBROUTINE RRTM_KGB4 USE YOMLUN_ECRAD,ONLY : NULRAD USE MPL_MODULE,ONLY : MPL_BROADCAST USE YOMTAG ,ONLY : MTAGRAD -USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC +USE YOMMP0_IFSAUX,ONLY : NPROC, MYPROC USE YOERRTO4 , ONLY : KAO ,KBO ,SELFREFO ,FORREFO, FRACREFAO ,FRACREFBO, & & KAO_D, KBO_D @@ -111,9 +120,9 @@ SUBROUTINE RRTM_KGB4 ! eta = h2o/(h20 + (rat) * co2), where rat is the ratio of the integrated ! line strength in the band of co2 to that of h2o. For instance, ! JS=1 refers to dry air (eta = 0), JS = 9 corresponds to eta = 1.0. -! The 2nd index in the array, JT, which runs from 1 to 5, corresponds -! to different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure +! The 2nd index in the array, JT, which runs from 1 to 5, corresponds +! to different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure ! level, JT = 2 refers to the temperature TREF-15, ! JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 ! is for TREF+30. The third index, JP, runs from 1 to 13 and refers @@ -125,15 +134,15 @@ SUBROUTINE RRTM_KGB4 ! The array KBO contains absorption coefs for each of the 16 g-intervals ! for a range of pressure levels < ~100mb, temperatures, and ratios -! of O3 to CO2. The first index in the array, JS, runs from 1 to 6, -! and corresponds to different O3 to CO2 ratios, as expressed through -! the binary species parameter eta, defined as eta = O3/(O3+RAT*H2O), -! where RAT is the ratio of the integrated line strength in the band -! of CO2 to that of O3. For instance, JS=1 refers to no O3 (eta = 0) +! of O3 to CO2. The first index in the array, JS, runs from 1 to 6, +! and corresponds to different O3 to CO2 ratios, as expressed through +! the binary species parameter eta, defined as eta = O3/(O3+RAT*H2O), +! where RAT is the ratio of the integrated line strength in the band +! of CO2 to that of O3. For instance, JS=1 refers to no O3 (eta = 0) ! and JS = 5 corresponds to eta = 1.0. The second index, JT, which -! runs from 1 to 5, corresponds to different temperatures. More -! specifically, JT = 3 means that the data are for the corresponding -! reference temperature TREF for this pressure level, JT = 2 refers +! runs from 1 to 5, corresponds to different temperatures. More +! specifically, JT = 3 means that the data are for the corresponding +! reference temperature TREF for this pressure level, JT = 2 refers ! to the TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and ! JT = 5 is for TREF+30. The third index, JP, runs from 13 to 59 and ! refers to the corresponding pressure level in PREF (e.g. JP = 13 is @@ -143,9 +152,9 @@ SUBROUTINE RRTM_KGB4 ! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index +! foreign-continuum (including the energy term). The first +! index refers to reference temperature (296,260,224,260) and +! pressure (970,475,219,3 mbar) levels. The second index ! runs over the g-channel (1 to 16). FORREFO(1,:) = (/ & diff --git a/ifsrrtm/rrtm_kgb5.F90 b/ifsrrtm/rrtm_kgb5.F90 index 37d0e3d7..e7fa7b47 100644 --- a/ifsrrtm/rrtm_kgb5.F90 +++ b/ifsrrtm/rrtm_kgb5.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE RRTM_KGB5 ! Originally by Eli J. Mlawer, Atmospheric & Environmental Research. @@ -19,7 +28,7 @@ SUBROUTINE RRTM_KGB5 USE YOERRTO5 , ONLY : KAO ,KBO ,SELFREFO ,FORREFO, FRACREFAO ,& & FRACREFBO, CCL4O , KAO_MO3, KAO_D, KBO_D -USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC +USE YOMMP0_IFSAUX,ONLY : NPROC, MYPROC ! ------------------------------------------------------------------ @@ -107,7 +116,7 @@ SUBROUTINE RRTM_KGB5 & 26.1407_JPRB, 53.9776_JPRB, 63.8085_JPRB, 36.1701_JPRB,& & 15.4099_JPRB, 10.23116_JPRB, 4.82948_JPRB, 5.03836_JPRB,& & 1.75558_JPRB, 0.0_JPRB , 0.0_JPRB , 0.0_JPRB ,& - & 0.0_JPRB , 0.0_JPRB , 0.0_JPRB , 0.0_JPRB /) + & 0.0_JPRB , 0.0_JPRB , 0.0_JPRB , 0.0_JPRB /) ! ------------------------------------------------------------------ @@ -120,10 +129,10 @@ SUBROUTINE RRTM_KGB5 ! eta = h2o/(h20 + (rat) * co2), where rat is the ratio of the integrated ! line strength in the band of co2 to that of h2o. For instance, ! JS=1 refers to dry air (eta = 0), JS = 9 corresponds to eta = 1.0. -! The 2nd index in the array, JT, which runs from 1 to 5, corresponds -! to different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure -! level, JT = 2 refers to the temperature TREF-15, +! The 2nd index in the array, JT, which runs from 1 to 5, corresponds +! to different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure +! level, JT = 2 refers to the temperature TREF-15, ! JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 ! is for TREF+30. The third index, JP, runs from 1 to 13 and refers ! to the reference pressure level (e.g. JP = 1 is for a @@ -134,15 +143,15 @@ SUBROUTINE RRTM_KGB5 ! The array KB contains absorption coefs for each of the 16 g-intervals ! for a range of pressure levels < ~100mb, temperatures, and ratios -! of O3 to CO2. The first index in the array, JS, runs from 1 to 5, -! and corresponds to different O3 to CO2 ratios, as expressed through -! the binary species parameter eta, defined as eta = O3/(O3+RAT*CO2), -! where RAT is the ratio of the integrated line strength in the band -! of co2 to that of O3. For instance, JS=1 refers to no O3 (eta = 0) +! of O3 to CO2. The first index in the array, JS, runs from 1 to 5, +! and corresponds to different O3 to CO2 ratios, as expressed through +! the binary species parameter eta, defined as eta = O3/(O3+RAT*CO2), +! where RAT is the ratio of the integrated line strength in the band +! of co2 to that of O3. For instance, JS=1 refers to no O3 (eta = 0) ! and JS = 5 corresponds to eta = 1.0. The second index, JT, which -! runs from 1 to 5, corresponds to different temperatures. More -! specifically, JT = 3 means that the data are for the corresponding -! reference temperature TREF for this pressure level, JT = 2 refers +! runs from 1 to 5, corresponds to different temperatures. More +! specifically, JT = 3 means that the data are for the corresponding +! reference temperature TREF for this pressure level, JT = 2 refers ! to the TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and ! JT = 5 is for TREF+30. The third index, JP, runs from 13 to 59 and ! refers to the corresponding pressure level in PREF (e.g. JP = 13 is @@ -151,16 +160,16 @@ SUBROUTINE RRTM_KGB5 -! The array KAO_Mxx contains the absorption coefficient for +! The array KAO_Mxx contains the absorption coefficient for ! a minor species at the 16 chosen g-values for a reference pressure ! level below 100~ mb. The first index in the array, JS, runs ! from 1 to 10, and corresponds to different gas column amount ratios, ! as expressed through the binary species parameter eta, defined as -! eta = gas1/(gas1 + (rat) * gas2), where rat is the -! ratio of the reference MLS column amount value of gas 1 -! to that of gas2. The second index refers to temperature -! in 7.2 degree increments. For instance, JT = 1 refers to a -! temperature of 188.0, JT = 2 refers to 195.2, etc. The third index +! eta = gas1/(gas1 + (rat) * gas2), where rat is the +! ratio of the reference MLS column amount value of gas 1 +! to that of gas2. The second index refers to temperature +! in 7.2 degree increments. For instance, JT = 1 refers to a +! temperature of 188.0, JT = 2 refers to 195.2, etc. The third index ! runs over the g-channel (1 to 16). KAO_MO3( 1, :, 1) = (/ & @@ -886,9 +895,9 @@ SUBROUTINE RRTM_KGB5 ! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index +! foreign-continuum (including the energy term). The first +! index refers to reference temperature (296,260,224,260) and +! pressure (970,475,219,3 mbar) levels. The second index ! runs over the g-channel (1 to 16). FORREFO(1,:) = (/ & diff --git a/ifsrrtm/rrtm_kgb6.F90 b/ifsrrtm/rrtm_kgb6.F90 index 1c57d211..a6b33fc2 100644 --- a/ifsrrtm/rrtm_kgb6.F90 +++ b/ifsrrtm/rrtm_kgb6.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE RRTM_KGB6 ! Originally by Eli J. Mlawer, Atmospheric & Environmental Research. @@ -17,8 +26,8 @@ SUBROUTINE RRTM_KGB6 USE YOMTAG ,ONLY : MTAGRAD USE YOERRTO6 , ONLY : KAO ,KAO_MCO2, SELFREFO, FORREFO ,FRACREFAO ,CFC11ADJO ,& - & CFC12O, KAO_D -USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC + & CFC12O, KAO_D +USE YOMMP0_IFSAUX,ONLY : NPROC, MYPROC ! ------------------------------------------------------------------ @@ -54,35 +63,35 @@ SUBROUTINE RRTM_KGB6 & 0.0_JPRB, 0.0_JPRB, 36.7627_JPRB, 150.757_JPRB, & & 81.4109_JPRB, 74.9112_JPRB, 56.9325_JPRB, 49.3226_JPRB, & & 57.1074_JPRB, 66.1202_JPRB, 109.557_JPRB, 89.0562_JPRB, & - & 149.865_JPRB, 196.140_JPRB, 258.393_JPRB, 80.9923_JPRB/) + & 149.865_JPRB, 196.140_JPRB, 258.393_JPRB, 80.9923_JPRB/) CFC12O( :) = (/& & 62.8368_JPRB, 43.2626_JPRB, 26.7549_JPRB, 22.2487_JPRB,& & 23.5029_JPRB, 34.8323_JPRB, 26.2335_JPRB, 23.2306_JPRB,& & 18.4062_JPRB, 13.9534_JPRB, 22.6268_JPRB, 24.2604_JPRB,& - & 30.0088_JPRB, 26.3634_JPRB, 15.8237_JPRB, 57.5050_JPRB/) + & 30.0088_JPRB, 26.3634_JPRB, 15.8237_JPRB, 57.5050_JPRB/) ! ------------------------------------------------------------------ -! The array KAO contains absorption coefs at the 16 chosen g-values +! The array KAO contains absorption coefs at the 16 chosen g-values ! for a range of pressure levels > ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the corresponding TREF for this pressure level, -! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, -! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second -! index, JP, runs from 1 to 13 and refers to the corresponding -! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb). -! The third index, IG, goes from 1 to 16, and tells us which +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the corresponding TREF for this pressure level, +! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, +! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second +! index, JP, runs from 1 to 13 and refers to the corresponding +! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb). +! The third index, IG, goes from 1 to 16, and tells us which ! g-interval the absorption coefficients are for. -! The array KAO_Mxx contains the absorption coefficient for +! The array KAO_Mxx contains the absorption coefficient for ! a minor species at the 16 chosen g-values for a reference pressure -! level below 100~ mb. The first index refers to temperature -! in 7.2 degree increments. For instance, JT = 1 refers to a -! temperature of 188.0, JT = 2 refers to 195.2, etc. The second index +! level below 100~ mb. The first index refers to temperature +! in 7.2 degree increments. For instance, JT = 1 refers to a +! temperature of 188.0, JT = 2 refers to 195.2, etc. The second index ! runs over the g-channel (1 to 16). KAO_MCO2(:, 1) = (/ & @@ -167,9 +176,9 @@ SUBROUTINE RRTM_KGB6 & 7.78398E-05_JPRB, 1.00516E-04_JPRB, 1.29799E-04_JPRB, 1.67612E-04_JPRB/) ! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index +! foreign-continuum (including the energy term). The first +! index refers to reference temperature (296,260,224,260) and +! pressure (970,475,219,3 mbar) levels. The second index ! runs over the g-channel (1 to 16). FORREFO(1,:) = (/ & diff --git a/ifsrrtm/rrtm_kgb7.F90 b/ifsrrtm/rrtm_kgb7.F90 index c6d3b181..2b7aa7a8 100644 --- a/ifsrrtm/rrtm_kgb7.F90 +++ b/ifsrrtm/rrtm_kgb7.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE RRTM_KGB7 ! Originally by Eli J. Mlawer, Atmospheric & Environmental Research. @@ -19,7 +28,7 @@ SUBROUTINE RRTM_KGB7 USE YOERRTO7 , ONLY : KAO ,KBO, KAO_MCO2 ,KBO_MCO2 ,SELFREFO ,FORREFO, & & FRACREFAO , FRACREFBO , KAO_D, KBO_D -USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC +USE YOMMP0_IFSAUX,ONLY : NPROC, MYPROC ! ------------------------------------------------------------------ @@ -88,12 +97,12 @@ SUBROUTINE RRTM_KGB7 ! ------------------------------------------------------------------ -! The array KAO contains absorption coefs at the 16 chosen g-values +! The array KAO contains absorption coefs at the 16 chosen g-values ! for a range of pressure levels> ~100mb, temperatures, and binary -! species parameters (see taumol.f for definition). The first -! index in the array, JS, runs from 1 to 9, and corresponds to -! different values of the binary species parameter. For instance, -! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, +! species parameters (see taumol.f for definition). The first +! index in the array, JS, runs from 1 to 9, and corresponds to +! different values of the binary species parameter. For instance, +! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, ! JS = 3 corresponds to the parameter value 2/8, etc. The second index ! in the array, JT, which runs from 1 to 5, corresponds to different ! temperatures. More specifically, JT = 3 means that the data are for @@ -106,29 +115,29 @@ SUBROUTINE RRTM_KGB7 -! The array KBO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure +! The array KBO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure ! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. ! The second index, JP, runs from 13 to 59 and refers to the JPth ! reference pressure level (see taumol.f for the value of these ! pressure levels in mb). The third index, IG, goes from 1 to 16, ! and tells us which g-interval the absorption coefficients are for. -! The array KAO_Mxx contains the absorption coefficient for +! The array KAO_Mxx contains the absorption coefficient for ! a minor species at the 16 chosen g-values for a reference pressure ! level below 100~ mb. The first index in the array, JS, runs ! from 1 to 10, and corresponds to different gas column amount ratios, ! as expressed through the binary species parameter eta, defined as -! eta = gas1/(gas1 + (rat) * gas2), where rat is the -! ratio of the reference MLS column amount value of gas 1 -! to that of gas2. The second index refers to temperature -! in 7.2 degree increments. For instance, JT = 1 refers to a -! temperature of 188.0, JT = 2 refers to 195.2, etc. The third index +! eta = gas1/(gas1 + (rat) * gas2), where rat is the +! ratio of the reference MLS column amount value of gas 1 +! to that of gas2. The second index refers to temperature +! in 7.2 degree increments. For instance, JT = 1 refers to a +! temperature of 188.0, JT = 2 refers to 195.2, etc. The third index ! runs over the g-channel (1 to 16). KAO_MCO2( 1, :, 1) = (/ & @@ -852,11 +861,11 @@ SUBROUTINE RRTM_KGB7 & 6.75633E-04_JPRB, 7.78588E-04_JPRB, 8.97231E-04_JPRB, 1.03395E-03_JPRB, 1.19151E-03_JPRB, & & 1.37307E-03_JPRB, 1.58231E-03_JPRB, 1.82342E-03_JPRB, 2.10128E-03_JPRB/) -! The array KBO_Mxx contains the absorption coefficient for +! The array KBO_Mxx contains the absorption coefficient for ! a minor species at the 16 chosen g-values for a reference pressure -! level above 100~ mb. The first index refers to temperature -! in 7.2 degree increments. For instance, JT = 1 refers to a -! temperature of 188.0, JT = 2 refers to 195.2, etc. The second index +! level above 100~ mb. The first index refers to temperature +! in 7.2 degree increments. For instance, JT = 1 refers to a +! temperature of 188.0, JT = 2 refers to 195.2, etc. The second index ! runs over the g-channel (1 to 16). KBO_MCO2(:, 1) = (/ & @@ -941,9 +950,9 @@ SUBROUTINE RRTM_KGB7 & 7.98972E-05_JPRB, 9.95951E-05_JPRB, 1.24149E-04_JPRB, 1.54757E-04_JPRB/) ! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296_rb,260_rb,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index +! foreign-continuum (including the energy term). The first +! index refers to reference temperature (296_rb,260_rb,224,260) and +! pressure (970,475,219,3 mbar) levels. The second index ! runs over the g-channel (1 to 16). FORREFO(1,:) = (/ & diff --git a/ifsrrtm/rrtm_kgb8.F90 b/ifsrrtm/rrtm_kgb8.F90 index d325e5df..ed4c972b 100644 --- a/ifsrrtm/rrtm_kgb8.F90 +++ b/ifsrrtm/rrtm_kgb8.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE RRTM_KGB8 ! Originally by Eli J. Mlawer, Atmospheric & Environmental Research. @@ -15,7 +24,7 @@ SUBROUTINE RRTM_KGB8 USE YOMLUN_ECRAD,ONLY : NULRAD USE MPL_MODULE,ONLY : MPL_BROADCAST USE YOMTAG ,ONLY : MTAGRAD -USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC +USE YOMMP0_IFSAUX,ONLY : NPROC, MYPROC USE YOERRTO8 , ONLY : KAO ,KBO ,SELFREFO ,FORREFO,FRACREFAO ,& & FRACREFBO, CFC12O ,CFC22ADJO ,KAO_MCO2,KBO_MCO2,& @@ -66,34 +75,34 @@ SUBROUTINE RRTM_KGB8 & 85.4027_JPRB, 89.4696_JPRB, 74.0959_JPRB, 67.7480_JPRB,& & 61.2444_JPRB, 59.9073_JPRB, 60.8296_JPRB, 63.0998_JPRB,& & 59.6110_JPRB, 64.0735_JPRB, 57.2622_JPRB, 58.9721_JPRB,& - & 43.5505_JPRB, 26.1192_JPRB, 32.7023_JPRB, 32.8667_JPRB/) + & 43.5505_JPRB, 26.1192_JPRB, 32.7023_JPRB, 32.8667_JPRB/) -! Original CFC22 is multiplied by 1.485 to account for the 780-850 cm-1 +! Original CFC22 is multiplied by 1.485 to account for the 780-850 cm-1 ! and 1290-1335 cm-1 bands. CFC22ADJO( :) = (/& & 135.335_JPRB, 89.6642_JPRB, 76.2375_JPRB, 65.9748_JPRB,& & 63.1164_JPRB, 60.2935_JPRB, 64.0299_JPRB, 75.4264_JPRB,& & 51.3018_JPRB, 7.07911_JPRB, 5.86928_JPRB, 0.398693_JPRB,& - & 2.82885_JPRB, 9.12751_JPRB, 6.28271_JPRB, 0.0_JPRB/) + & 2.82885_JPRB, 9.12751_JPRB, 6.28271_JPRB, 0.0_JPRB/) ! ------------------------------------------------------------------ -! The array KAO contains absorption coefs at the 16 chosen g-values +! The array KAO contains absorption coefs at the 16 chosen g-values ! for a range of pressure levels > ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the corresponding TREF for this pressure level, -! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, -! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second -! index, JP, runs from 1 to 13 and refers to the corresponding -! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb). -! The third index, IG, goes from 1 to 16, and tells us which +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the corresponding TREF for this pressure level, +! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, +! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second +! index, JP, runs from 1 to 13 and refers to the corresponding +! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb). +! The third index, IG, goes from 1 to 16, and tells us which ! g-interval the absorption coefficients are for. -! The array KA contains absorption coef5s at the 16 chosen g-values +! The array KA contains absorption coef5s at the 16 chosen g-values ! for a range of pressure levels > ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the cooresponding TREF for this pressure level, +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the cooresponding TREF for this pressure level, ! JT = 2 refers to the temperature ! TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 ! is for TREF+30. The second index, JP, runs from 1 to 13 and refers @@ -103,13 +112,13 @@ SUBROUTINE RRTM_KGB8 -! The array KBO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure +! The array KBO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure ! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. ! The second index, JP, runs from 13 to 59 and refers to the JPth ! reference pressure level (see taumol.f for the value of these ! pressure levels in mb). The third index, IG, goes from 1 to 16, @@ -117,11 +126,11 @@ SUBROUTINE RRTM_KGB8 -! The array KAO_Mxx contains the absorption coefficient for +! The array KAO_Mxx contains the absorption coefficient for ! a minor species at the 16 chosen g-values for a reference pressure -! level below 100~ mb. The first index refers to temperature -! in 7.2 degree increments. For instance, JT = 1 refers to a -! temperature of 188.0, JT = 2 refers to 195.2, etc. The second index +! level below 100~ mb. The first index refers to temperature +! in 7.2 degree increments. For instance, JT = 1 refers to a +! temperature of 188.0, JT = 2 refers to 195.2, etc. The second index ! runs over the g-channel (1 to 16). KAO_MCO2(:, 1) = (/ & @@ -367,11 +376,11 @@ SUBROUTINE RRTM_KGB8 & 1.82960E-01_JPRB, 1.79630E-01_JPRB, 1.76361E-01_JPRB, 1.73151E-01_JPRB, 1.70000E-01_JPRB, & & 1.66906E-01_JPRB, 1.63868E-01_JPRB, 1.60886E-01_JPRB, 1.57958E-01_JPRB/) -! The array KBO_Mxx contains the absorption coefficient for +! The array KBO_Mxx contains the absorption coefficient for ! a minor species at the 16 chosen g-values for a reference pressure -! level above 100~ mb. The first index refers to temperature -! in 7.2 degree increments. For instance, JT = 1 refers to a -! temperature of 188.0, JT = 2 refers to 195.2, etc. The second index +! level above 100~ mb. The first index refers to temperature +! in 7.2 degree increments. For instance, JT = 1 refers to a +! temperature of 188.0, JT = 2 refers to 195.2, etc. The second index ! runs over the g-channel (1 to 16). KBO_MCO2(:, 1) = (/ & @@ -537,9 +546,9 @@ SUBROUTINE RRTM_KGB8 & 5.28064E-01_JPRB, 6.82266E-01_JPRB, 8.81496E-01_JPRB, 1.13891E+00_JPRB/) ! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index +! foreign-continuum (including the energy term). The first +! index refers to reference temperature (296,260,224,260) and +! pressure (970,475,219,3 mbar) levels. The second index ! runs over the g-channel (1 to 16). FORREFO(1,:) = (/ & diff --git a/ifsrrtm/rrtm_kgb9.F90 b/ifsrrtm/rrtm_kgb9.F90 index e827ac54..63aa6b45 100644 --- a/ifsrrtm/rrtm_kgb9.F90 +++ b/ifsrrtm/rrtm_kgb9.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE RRTM_KGB9 ! Originally by Eli J. Mlawer, Atmospheric & Environmental Research. @@ -15,7 +24,7 @@ SUBROUTINE RRTM_KGB9 USE YOMLUN_ECRAD,ONLY : NULRAD USE MPL_MODULE,ONLY : MPL_BROADCAST USE YOMTAG ,ONLY : MTAGRAD -USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC +USE YOMMP0_IFSAUX,ONLY : NPROC, MYPROC USE YOERRTO9 , ONLY : KAO ,KBO ,SELFREFO ,FORREFO, FRACREFAO ,& & FRACREFBO, KAO_MN2O, KBO_MN2O, KAO_D, KBO_D @@ -88,12 +97,12 @@ SUBROUTINE RRTM_KGB9 ! ------------------------------------------------------------------ -! The array KAO contains absorption coefs at the 16 chosen g-values +! The array KAO contains absorption coefs at the 16 chosen g-values ! for a range of pressure levels> ~100mb, temperatures, and binary -! species parameters (see taumol.f for definition). The first -! index in the array, JS, runs from 1 to 11, and corresponds to -! different values of the binary species parameter. For instance, -! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, +! species parameters (see taumol.f for definition). The first +! index in the array, JS, runs from 1 to 11, and corresponds to +! different values of the binary species parameter. For instance, +! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, ! JS = 3 corresponds to the parameter value 2/8, etc. The second index ! in the array, JT, which runs from 1 to 5, corresponds to different ! temperatures. More specifically, JT = 3 means that the data are for @@ -106,29 +115,29 @@ SUBROUTINE RRTM_KGB9 -! The array KBO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure +! The array KBO contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure ! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. ! The second index, JP, runs from 13 to 59 and refers to the JPth ! reference pressure level (see taumol.f for the value of these ! pressure levels in mb). The third index, IG, goes from 1 to 16, ! and tells us which g-interval the absorption coefficients are for. -! The array KAO_Mxx contains the absorption coefficient for +! The array KAO_Mxx contains the absorption coefficient for ! a minor species at the 16 chosen g-values for a reference pressure ! level below 100~ mb. The first index in the array, JS, runs ! from 1 to 10, and corresponds to different gas column amount ratios, ! as expressed through the binary species parameter eta, defined as -! eta = gas1/(gas1 + (rat) * gas2), where rat is the -! ratio of the reference MLS column amount value of gas 1 -! to that of gas2. The second index refers to temperature -! in 7.2 degree increments. For instance, JT = 1 refers to a -! temperature of 188.0, JT = 2 refers to 195.2, etc. The third index +! eta = gas1/(gas1 + (rat) * gas2), where rat is the +! ratio of the reference MLS column amount value of gas 1 +! to that of gas2. The second index refers to temperature +! in 7.2 degree increments. For instance, JT = 1 refers to a +! temperature of 188.0, JT = 2 refers to 195.2, etc. The third index ! runs over the g-channel (1 to 16). KAO_MN2O( 1, :, 1) = (/ & @@ -852,11 +861,11 @@ SUBROUTINE RRTM_KGB9 & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, & & 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB, 0.00000E+00_JPRB/) -! The array KBO_Mxx contains the absorption coefficient for +! The array KBO_Mxx contains the absorption coefficient for ! a minor species at the 16 chosen g-values for a reference pressure -! level above 100~ mb. The first index refers to temperature -! in 7.2 degree increments. For instance, JT = 1 refers to a -! temperature of 188.0, JT = 2 refers to 195.2, etc. The second index +! level above 100~ mb. The first index refers to temperature +! in 7.2 degree increments. For instance, JT = 1 refers to a +! temperature of 188.0, JT = 2 refers to 195.2, etc. The second index ! runs over the g-channel (1 to 16). KBO_MN2O(:, 1) = (/ & @@ -941,9 +950,9 @@ SUBROUTINE RRTM_KGB9 & 3.35065E-01_JPRB, 4.74225E-01_JPRB, 6.71180E-01_JPRB, 9.49936E-01_JPRB/) ! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index +! foreign-continuum (including the energy term). The first +! index refers to reference temperature (296,260,224,260) and +! pressure (970,475,219,3 mbar) levels. The second index ! runs over the g-channel (1 to 16). FORREFO(1,:) = (/ & diff --git a/ifsrrtm/rrtm_prepare_gases.F90 b/ifsrrtm/rrtm_prepare_gases.F90 index 4752df70..a4a10487 100644 --- a/ifsrrtm/rrtm_prepare_gases.F90 +++ b/ifsrrtm/rrtm_prepare_gases.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE RRTM_PREPARE_GASES & &( KIDIA, KFDIA, KLON, KLEV, & & PAPH , PAP , & @@ -178,8 +187,7 @@ SUBROUTINE RRTM_PREPARE_GASES & PTAVEL(JL,JK) = PT(JL,KLEV-JK+1) PZ(JL,JK) = PAPH(JL,KLEV-JK+1)/100._JPRB PTZ(JL,JK) = PTH(JL,KLEV-JK+1) - ! RRTMG cannot cope with zero or negative water vapour - PWKL(JL,1,JK) = MAX(PQ(JL,KLEV-JK+1),1.0E-15)*ZAMD/ZAMW + PWKL(JL,1,JK) = PQ(JL,KLEV-JK+1)*ZAMD/ZAMW PWKL(JL,2,JK) = PCO2(JL,KLEV-JK+1)*ZAMD/ZAMCO2 PWKL(JL,3,JK) = POZN(JL,KLEV-JK+1)*ZAMD/ZAMO PWKL(JL,4,JK) = PN2O(JL,KLEV-JK+1)*ZAMD/ZAMN2O diff --git a/ifsrrtm/rrtm_setcoef_140gp.F90 b/ifsrrtm/rrtm_setcoef_140gp.F90 index a7d2af51..5d2d6270 100644 --- a/ifsrrtm/rrtm_setcoef_140gp.F90 +++ b/ifsrrtm/rrtm_setcoef_140gp.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE RRTM_SETCOEF_140GP (KIDIA,KFDIA,KLEV,P_COLDRY,P_WBROAD,P_WKL,& & P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,& & P_COLH2O,P_COLCO2,P_COLO3,P_COLN2O,P_COLCH4, P_COLO2,P_CO2MULT, P_COLBRD, & diff --git a/ifsrrtm/rrtm_taumol1.F90 b/ifsrrtm/rrtm_taumol1.F90 index 58d832fe..c00acff8 100644 --- a/ifsrrtm/rrtm_taumol1.F90 +++ b/ifsrrtm/rrtm_taumol1.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE RRTM_TAUMOL1 (KIDIA,KFDIA,KLEV,P_TAU,PAVEL,& & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,& & P_COLH2O,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC,P_MINORFRAC,K_INDMINOR,PSCALEMINORN2,PCOLBRD) diff --git a/ifsrrtm/rrtm_taumol10.F90 b/ifsrrtm/rrtm_taumol10.F90 index b20f4781..f96091c5 100644 --- a/ifsrrtm/rrtm_taumol10.F90 +++ b/ifsrrtm/rrtm_taumol10.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! !******************************************************************************* SUBROUTINE RRTM_TAUMOL10 (KIDIA,KFDIA,KLEV,P_TAU,& & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,& diff --git a/ifsrrtm/rrtm_taumol11.F90 b/ifsrrtm/rrtm_taumol11.F90 index 90a12263..7a0450ff 100644 --- a/ifsrrtm/rrtm_taumol11.F90 +++ b/ifsrrtm/rrtm_taumol11.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! !****************************************************************************** SUBROUTINE RRTM_TAUMOL11 (KIDIA,KFDIA,KLEV,P_TAU,& & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,& diff --git a/ifsrrtm/rrtm_taumol12.F90 b/ifsrrtm/rrtm_taumol12.F90 index e31bebfa..49f4c143 100644 --- a/ifsrrtm/rrtm_taumol12.F90 +++ b/ifsrrtm/rrtm_taumol12.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! !---------------------------------------------------------------------------- SUBROUTINE RRTM_TAUMOL12 (KIDIA,KFDIA,KLEV,P_TAU,& & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,P_ONEMINUS,& diff --git a/ifsrrtm/rrtm_taumol13.F90 b/ifsrrtm/rrtm_taumol13.F90 index 6988b6ab..79f76891 100644 --- a/ifsrrtm/rrtm_taumol13.F90 +++ b/ifsrrtm/rrtm_taumol13.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! !---------------------------------------------------------------------------- SUBROUTINE RRTM_TAUMOL13 (KIDIA,KFDIA,KLEV,P_TAU,& & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,P_ONEMINUS,& diff --git a/ifsrrtm/rrtm_taumol14.F90 b/ifsrrtm/rrtm_taumol14.F90 index de96f32b..97d24afa 100644 --- a/ifsrrtm/rrtm_taumol14.F90 +++ b/ifsrrtm/rrtm_taumol14.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! !****************************************************************************** SUBROUTINE RRTM_TAUMOL14 (KIDIA,KFDIA,KLEV,P_TAU,& & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,& diff --git a/ifsrrtm/rrtm_taumol15.F90 b/ifsrrtm/rrtm_taumol15.F90 index 6306eb99..148471c4 100644 --- a/ifsrrtm/rrtm_taumol15.F90 +++ b/ifsrrtm/rrtm_taumol15.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! !---------------------------------------------------------------------------- SUBROUTINE RRTM_TAUMOL15 (KIDIA,KFDIA,KLEV,P_TAU,& & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,P_ONEMINUS,& diff --git a/ifsrrtm/rrtm_taumol16.F90 b/ifsrrtm/rrtm_taumol16.F90 index af251eb5..4e718e8a 100644 --- a/ifsrrtm/rrtm_taumol16.F90 +++ b/ifsrrtm/rrtm_taumol16.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! !---------------------------------------------------------------------------- SUBROUTINE RRTM_TAUMOL16 (KIDIA,KFDIA,KLEV,P_TAU,& & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,P_ONEMINUS,& diff --git a/ifsrrtm/rrtm_taumol2.F90 b/ifsrrtm/rrtm_taumol2.F90 index ebd556dc..d32f9aac 100644 --- a/ifsrrtm/rrtm_taumol2.F90 +++ b/ifsrrtm/rrtm_taumol2.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! !---------------------------------------------------------------------------- SUBROUTINE RRTM_TAUMOL2 (KIDIA,KFDIA,KLEV,P_TAU,PAVEL,P_COLDRY,& & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,& diff --git a/ifsrrtm/rrtm_taumol3.F90 b/ifsrrtm/rrtm_taumol3.F90 index 9d3ba286..b2c4fe4f 100644 --- a/ifsrrtm/rrtm_taumol3.F90 +++ b/ifsrrtm/rrtm_taumol3.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! !---------------------------------------------------------------------------- SUBROUTINE RRTM_TAUMOL3 (KIDIA,KFDIA,KLEV,P_TAU,& & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,P_ONEMINUS,& diff --git a/ifsrrtm/rrtm_taumol4.F90 b/ifsrrtm/rrtm_taumol4.F90 index 9bf4074e..44033ea5 100644 --- a/ifsrrtm/rrtm_taumol4.F90 +++ b/ifsrrtm/rrtm_taumol4.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! !---------------------------------------------------------------------------- SUBROUTINE RRTM_TAUMOL4 (KIDIA,KFDIA,KLEV,P_TAU,& & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,P_ONEMINUS,& diff --git a/ifsrrtm/rrtm_taumol5.F90 b/ifsrrtm/rrtm_taumol5.F90 index 246caca6..ab825116 100644 --- a/ifsrrtm/rrtm_taumol5.F90 +++ b/ifsrrtm/rrtm_taumol5.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! !---------------------------------------------------------------------------- SUBROUTINE RRTM_TAUMOL5 (KIDIA,KFDIA,KLEV,P_TAU,P_WX,& & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,P_ONEMINUS,& diff --git a/ifsrrtm/rrtm_taumol6.F90 b/ifsrrtm/rrtm_taumol6.F90 index 569f1a13..84d68907 100644 --- a/ifsrrtm/rrtm_taumol6.F90 +++ b/ifsrrtm/rrtm_taumol6.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! !---------------------------------------------------------------------------- SUBROUTINE RRTM_TAUMOL6 (KIDIA,KFDIA,KLEV,P_TAU,P_WX,& & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,& diff --git a/ifsrrtm/rrtm_taumol7.F90 b/ifsrrtm/rrtm_taumol7.F90 index 09e6e6f2..f11be545 100644 --- a/ifsrrtm/rrtm_taumol7.F90 +++ b/ifsrrtm/rrtm_taumol7.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! !---------------------------------------------------------------------------- SUBROUTINE RRTM_TAUMOL7 (KIDIA,KFDIA,KLEV,P_TAU,& & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,P_ONEMINUS,& diff --git a/ifsrrtm/rrtm_taumol8.F90 b/ifsrrtm/rrtm_taumol8.F90 index c606249a..81d67c66 100644 --- a/ifsrrtm/rrtm_taumol8.F90 +++ b/ifsrrtm/rrtm_taumol8.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! !******************************************************************************* SUBROUTINE RRTM_TAUMOL8 (KIDIA,KFDIA,KLEV,P_TAU,P_WX,& & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,& diff --git a/ifsrrtm/rrtm_taumol9.F90 b/ifsrrtm/rrtm_taumol9.F90 index 9728df98..02fa2a02 100644 --- a/ifsrrtm/rrtm_taumol9.F90 +++ b/ifsrrtm/rrtm_taumol9.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! !---------------------------------------------------------------------------- SUBROUTINE RRTM_TAUMOL9 (KIDIA,KFDIA,KLEV,P_TAU,& & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,P_ONEMINUS,& diff --git a/ifsrrtm/srtm_cmbgb16.F90 b/ifsrrtm/srtm_cmbgb16.F90 index 627e12cb..2ba10663 100644 --- a/ifsrrtm/srtm_cmbgb16.F90 +++ b/ifsrrtm/srtm_cmbgb16.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_CMBGB16 diff --git a/ifsrrtm/srtm_cmbgb17.F90 b/ifsrrtm/srtm_cmbgb17.F90 index d9be9183..2f692605 100644 --- a/ifsrrtm/srtm_cmbgb17.F90 +++ b/ifsrrtm/srtm_cmbgb17.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_CMBGB17 ! BAND 17: 3250-4000 cm-1 (low - H2O,CO2; high - H2O,CO2) diff --git a/ifsrrtm/srtm_cmbgb18.F90 b/ifsrrtm/srtm_cmbgb18.F90 index 7addf297..20404376 100644 --- a/ifsrrtm/srtm_cmbgb18.F90 +++ b/ifsrrtm/srtm_cmbgb18.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_CMBGB18 ! BAND 18: 4000-4650 cm-1 (low - H2O,CH4; high - CH4) diff --git a/ifsrrtm/srtm_cmbgb19.F90 b/ifsrrtm/srtm_cmbgb19.F90 index a491fcf3..5dd14a72 100644 --- a/ifsrrtm/srtm_cmbgb19.F90 +++ b/ifsrrtm/srtm_cmbgb19.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_CMBGB19 ! BAND 19: 4650-5150 cm-1 (low - H2O,CO2; high - CO2) diff --git a/ifsrrtm/srtm_cmbgb20.F90 b/ifsrrtm/srtm_cmbgb20.F90 index 933be0ad..415444ec 100644 --- a/ifsrrtm/srtm_cmbgb20.F90 +++ b/ifsrrtm/srtm_cmbgb20.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_CMBGB20 ! BAND 20: 5150-6150 cm-1 (low - H2O; high - H2O) diff --git a/ifsrrtm/srtm_cmbgb21.F90 b/ifsrrtm/srtm_cmbgb21.F90 index 9b2e0a48..a9fffea0 100644 --- a/ifsrrtm/srtm_cmbgb21.F90 +++ b/ifsrrtm/srtm_cmbgb21.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_CMBGB21 ! BAND 21: 6150-7700 cm-1 (low - H2O,CO2; high - H2O,CO2) diff --git a/ifsrrtm/srtm_cmbgb22.F90 b/ifsrrtm/srtm_cmbgb22.F90 index abd8a557..a8ffcf0d 100644 --- a/ifsrrtm/srtm_cmbgb22.F90 +++ b/ifsrrtm/srtm_cmbgb22.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_CMBGB22 ! BAND 22: 7700-8050 cm-1 (low - H2O,O2; high - O2) diff --git a/ifsrrtm/srtm_cmbgb23.F90 b/ifsrrtm/srtm_cmbgb23.F90 index 93758ce6..3e0bbc41 100644 --- a/ifsrrtm/srtm_cmbgb23.F90 +++ b/ifsrrtm/srtm_cmbgb23.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_CMBGB23 ! BAND 23: 8050-12850 cm-1 (low - H2O; high - nothing) diff --git a/ifsrrtm/srtm_cmbgb24.F90 b/ifsrrtm/srtm_cmbgb24.F90 index 21042f58..2701bccf 100644 --- a/ifsrrtm/srtm_cmbgb24.F90 +++ b/ifsrrtm/srtm_cmbgb24.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_CMBGB24 ! BAND 24: 12850-16000 cm-1 (low - H2O,O2; high - O2) diff --git a/ifsrrtm/srtm_cmbgb25.F90 b/ifsrrtm/srtm_cmbgb25.F90 index 090afe85..e823b1c0 100644 --- a/ifsrrtm/srtm_cmbgb25.F90 +++ b/ifsrrtm/srtm_cmbgb25.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_CMBGB25 ! BAND 25: 16000-22650 cm-1 (low - H2O; high - nothing) diff --git a/ifsrrtm/srtm_cmbgb26.F90 b/ifsrrtm/srtm_cmbgb26.F90 index c688155a..a213dd8e 100644 --- a/ifsrrtm/srtm_cmbgb26.F90 +++ b/ifsrrtm/srtm_cmbgb26.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_CMBGB26 ! BAND 26: 22650-29000 cm-1 (low - nothing; high - nothing) diff --git a/ifsrrtm/srtm_cmbgb27.F90 b/ifsrrtm/srtm_cmbgb27.F90 index 4c2b2d45..c84bb5d2 100644 --- a/ifsrrtm/srtm_cmbgb27.F90 +++ b/ifsrrtm/srtm_cmbgb27.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_CMBGB27 ! BAND 27: 29000-38000 cm-1 (low - O3; high - O3) diff --git a/ifsrrtm/srtm_cmbgb28.F90 b/ifsrrtm/srtm_cmbgb28.F90 index a5ea510a..aa71c48a 100644 --- a/ifsrrtm/srtm_cmbgb28.F90 +++ b/ifsrrtm/srtm_cmbgb28.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_CMBGB28 ! BAND 28: 38000-50000 cm-1 (low - O3,O2; high - O3,O2) diff --git a/ifsrrtm/srtm_cmbgb29.F90 b/ifsrrtm/srtm_cmbgb29.F90 index 72520953..0dbef5b6 100644 --- a/ifsrrtm/srtm_cmbgb29.F90 +++ b/ifsrrtm/srtm_cmbgb29.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_CMBGB29 ! BAND 29: 820-2600 cm-1 (low - H2O; high - CO2) diff --git a/ifsrrtm/srtm_gas_optical_depth.F90 b/ifsrrtm/srtm_gas_optical_depth.F90 index 07b5bdf5..e8883075 100644 --- a/ifsrrtm/srtm_gas_optical_depth.F90 +++ b/ifsrrtm/srtm_gas_optical_depth.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! #ifdef RS6K @PROCESS HOT(NOVECTOR) NOSTRICT #endif diff --git a/ifsrrtm/srtm_init.F90 b/ifsrrtm/srtm_init.F90 index b984d31b..119b35b4 100644 --- a/ifsrrtm/srtm_init.F90 +++ b/ifsrrtm/srtm_init.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_INIT(CDIRECTORY, NWVCONTINUUM) !-- read in the basic coefficients to configure RRTM_SW @@ -11,6 +20,7 @@ SUBROUTINE SRTM_INIT(CDIRECTORY, NWVCONTINUUM) USE YOESRTM , ONLY : NGN USE YOESRTWN , ONLY : NG, NGM, WT, NGC, RWGT, WTSM !USE YOESRTWN , ONLY : NG, NGM, WT, NGC, NGN, RWGT, WTSM +!USE YOMLUN , ONLY : NULOUT IMPLICIT NONE @@ -85,11 +95,11 @@ SUBROUTINE SRTM_INIT(CDIRECTORY, NWVCONTINUUM) IF (PRESENT(NWVCONTINUUM)) THEN ! Modify the shortwave water vapour continuum, if requested CALL MODIFY_WV_CONTINUUM(NWVCONTINUUM) -END IF +ENDIF !-- read in the cloud optical properties -!- creates module YOESRTOP with EXTLIQ1, SSALIQ1, ASYLIQ1, -! EXTICE3, SSAICE3, ASYICE3, FDLICE3 +!- creates module YOESRTOP with EXTLIQ1, SSALIQ1, ASYLIQ1, +! EXTICE3, SSAICE3, ASYICE3, FDLICE3 !-- RRTM_SW cloud optical properties are not used ! SRTM_CLDPROP is not called @@ -149,3 +159,4 @@ SUBROUTINE SRTM_INIT(CDIRECTORY, NWVCONTINUUM) !----------------------------------------------------------------------- IF (LHOOK) CALL DR_HOOK('SRTM_INIT',1,ZHOOK_HANDLE) END SUBROUTINE SRTM_INIT + diff --git a/ifsrrtm/srtm_kgb16.F90 b/ifsrrtm/srtm_kgb16.F90 index 98a7c9d4..173f0865 100644 --- a/ifsrrtm/srtm_kgb16.F90 +++ b/ifsrrtm/srtm_kgb16.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_KGB16(CDIRECTORY) ! Originally by J.Delamere, Atmospheric & Environmental Research. @@ -12,8 +21,8 @@ SUBROUTINE SRTM_KGB16(CDIRECTORY) USE PARKIND1 , ONLY : JPRB USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN_ECRAD, ONLY : NULRAD, NULOUT -USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC +USE YOMLUN_ECRAD,ONLY : NULRAD, NULOUT +USE YOMMP0_IFSAUX,ONLY : NPROC, MYPROC USE MPL_MODULE, ONLY : MPL_BROADCAST USE YOMTAG , ONLY : MTAGRAD USE YOESRTA16 , ONLY : KA, KB, SELFREF, FORREF, SFLUXREF, RAYL, STRRAT1, LAYREFFR, & @@ -35,8 +44,12 @@ SUBROUTINE SRTM_KGB16(CDIRECTORY) IF( MYPROC==1 )THEN CLF1 = TRIM(CDIRECTORY) // "/RADSRTM" WRITE(NULOUT,'(a,a)')'Reading RRTMG shortwave data file ', TRIM(CLF1) +#ifdef LITTLE_ENDIAN OPEN(NULRAD,FILE=TRIM(CLF1),FORM="UNFORMATTED",ACTION="READ",ERR=1000,CONVERT='BIG_ENDIAN') - +#else + OPEN(NULRAD,FILE=TRIM(CLF1),FORM="UNFORMATTED",ACTION="READ",ERR=1000) +#endif + READ(NULRAD,ERR=1001) KA_D,KB_D KA = REAL(KA_D,JPRB) KB = REAL(KB_D,JPRB) @@ -50,7 +63,7 @@ SUBROUTINE SRTM_KGB16(CDIRECTORY) & 1.92269_JPRB , 1.72844_JPRB , 1.64326_JPRB , 1.58451_JPRB & & , 1.44031_JPRB , 1.25108_JPRB , 1.02724_JPRB , 0.776759_JPRB & & , 0.534444_JPRB , 5.87755E-02_JPRB, 4.86706E-02_JPRB, 3.87989E-02_JPRB & - & , 2.84532E-02_JPRB, 1.82431E-02_JPRB, 6.92320E-03_JPRB, 9.70770E-04_JPRB /) + & , 2.84532E-02_JPRB, 1.82431E-02_JPRB, 6.92320E-03_JPRB, 9.70770E-04_JPRB /) ! Rayleigh extinction coefficient at v = 2925 cm-1. RAYL = 2.91E-10_JPRB @@ -61,12 +74,12 @@ SUBROUTINE SRTM_KGB16(CDIRECTORY) ! ------------------------------------------------------------------ -! The array KA contains absorption coefs at the 16 chosen g-values +! The array KA contains absorption coefs at the 16 chosen g-values ! for a range of pressure levels> ~100mb, temperatures, and binary -! species parameters (see taumol.f for definition). The first -! index in the array, JS, runs from 1 to 9, and corresponds to -! different values of the binary species parameter. For instance, -! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, +! species parameters (see taumol.f for definition). The first +! index in the array, JS, runs from 1 to 9, and corresponds to +! different values of the binary species parameter. For instance, +! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, ! JS = 3 corresponds to the parameter value 2/8, etc. The second index ! in the array, JT, which runs from 1 to 5, corresponds to different ! temperatures. More specifically, JT = 3 means that the data are for @@ -79,13 +92,13 @@ SUBROUTINE SRTM_KGB16(CDIRECTORY) ! ----------------------------------------------------------------- ! ----------------------------------------------------------------- -! The array KB contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure +! The array KB contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure ! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. ! The second index, JP, runs from 13 to 59 and refers to the JPth ! reference pressure level (see taumol.f for the value of these ! pressure levels in mb). The third index, IG, goes from 1 to 16, @@ -118,52 +131,52 @@ SUBROUTINE SRTM_KGB16(CDIRECTORY) SELFREF(:, 1) = (/ & & 0.126758E-02_JPRB, 0.105253E-02_JPRB, 0.873963E-03_JPRB, 0.725690E-03_JPRB, 0.602573E-03_JPRB, & - & 0.500344E-03_JPRB, 0.415458E-03_JPRB, 0.344973E-03_JPRB, 0.286447E-03_JPRB, 0.237849E-03_JPRB /) + & 0.500344E-03_JPRB, 0.415458E-03_JPRB, 0.344973E-03_JPRB, 0.286447E-03_JPRB, 0.237849E-03_JPRB /) SELFREF(:, 2) = (/ & & 0.144006E-02_JPRB, 0.118514E-02_JPRB, 0.975351E-03_JPRB, 0.802697E-03_JPRB, 0.660606E-03_JPRB, & - & 0.543667E-03_JPRB, 0.447429E-03_JPRB, 0.368226E-03_JPRB, 0.303044E-03_JPRB, 0.249400E-03_JPRB /) + & 0.543667E-03_JPRB, 0.447429E-03_JPRB, 0.368226E-03_JPRB, 0.303044E-03_JPRB, 0.249400E-03_JPRB /) SELFREF(:, 3) = (/ & & 0.294018E-02_JPRB, 0.227428E-02_JPRB, 0.175920E-02_JPRB, 0.136077E-02_JPRB, 0.105258E-02_JPRB, & - & 0.814189E-03_JPRB, 0.629789E-03_JPRB, 0.487153E-03_JPRB, 0.376821E-03_JPRB, 0.291478E-03_JPRB /) + & 0.814189E-03_JPRB, 0.629789E-03_JPRB, 0.487153E-03_JPRB, 0.376821E-03_JPRB, 0.291478E-03_JPRB /) SELFREF(:, 4) = (/ & & 0.395290E-02_JPRB, 0.348405E-02_JPRB, 0.307081E-02_JPRB, 0.270658E-02_JPRB, 0.238556E-02_JPRB, & - & 0.210261E-02_JPRB, 0.185322E-02_JPRB, 0.163341E-02_JPRB, 0.143967E-02_JPRB, 0.126891E-02_JPRB /) + & 0.210261E-02_JPRB, 0.185322E-02_JPRB, 0.163341E-02_JPRB, 0.143967E-02_JPRB, 0.126891E-02_JPRB /) SELFREF(:, 5) = (/ & & 0.419122E-02_JPRB, 0.385638E-02_JPRB, 0.354829E-02_JPRB, 0.326481E-02_JPRB, 0.300398E-02_JPRB, & - & 0.276399E-02_JPRB, 0.254317E-02_JPRB, 0.234000E-02_JPRB, 0.215305E-02_JPRB, 0.198104E-02_JPRB /) + & 0.276399E-02_JPRB, 0.254317E-02_JPRB, 0.234000E-02_JPRB, 0.215305E-02_JPRB, 0.198104E-02_JPRB /) SELFREF(:, 6) = (/ & & 0.495659E-02_JPRB, 0.456777E-02_JPRB, 0.420945E-02_JPRB, 0.387924E-02_JPRB, 0.357494E-02_JPRB, & - & 0.329450E-02_JPRB, 0.303606E-02_JPRB, 0.279790E-02_JPRB, 0.257842E-02_JPRB, 0.237615E-02_JPRB /) + & 0.329450E-02_JPRB, 0.303606E-02_JPRB, 0.279790E-02_JPRB, 0.257842E-02_JPRB, 0.237615E-02_JPRB /) SELFREF(:, 7) = (/ & & 0.526981E-02_JPRB, 0.490687E-02_JPRB, 0.456893E-02_JPRB, 0.425426E-02_JPRB, 0.396126E-02_JPRB, & - & 0.368844E-02_JPRB, 0.343441E-02_JPRB, 0.319788E-02_JPRB, 0.297764E-02_JPRB, 0.277256E-02_JPRB /) + & 0.368844E-02_JPRB, 0.343441E-02_JPRB, 0.319788E-02_JPRB, 0.297764E-02_JPRB, 0.277256E-02_JPRB /) SELFREF(:, 8) = (/ & & 0.575426E-02_JPRB, 0.531597E-02_JPRB, 0.491106E-02_JPRB, 0.453699E-02_JPRB, 0.419141E-02_JPRB, & - & 0.387216E-02_JPRB, 0.357722E-02_JPRB, 0.330475E-02_JPRB, 0.305303E-02_JPRB, 0.282048E-02_JPRB /) + & 0.387216E-02_JPRB, 0.357722E-02_JPRB, 0.330475E-02_JPRB, 0.305303E-02_JPRB, 0.282048E-02_JPRB /) SELFREF(:, 9) = (/ & & 0.549881E-02_JPRB, 0.514328E-02_JPRB, 0.481074E-02_JPRB, 0.449970E-02_JPRB, 0.420877E-02_JPRB, & - & 0.393665E-02_JPRB, 0.368213E-02_JPRB, 0.344406E-02_JPRB, 0.322138E-02_JPRB, 0.301310E-02_JPRB /) + & 0.393665E-02_JPRB, 0.368213E-02_JPRB, 0.344406E-02_JPRB, 0.322138E-02_JPRB, 0.301310E-02_JPRB /) SELFREF(:,10) = (/ & & 0.605357E-02_JPRB, 0.561246E-02_JPRB, 0.520349E-02_JPRB, 0.482432E-02_JPRB, 0.447278E-02_JPRB, & - & 0.414686E-02_JPRB, 0.384469E-02_JPRB, 0.356453E-02_JPRB, 0.330479E-02_JPRB, 0.306398E-02_JPRB /) + & 0.414686E-02_JPRB, 0.384469E-02_JPRB, 0.356453E-02_JPRB, 0.330479E-02_JPRB, 0.306398E-02_JPRB /) SELFREF(:,11) = (/ & & 0.640504E-02_JPRB, 0.587858E-02_JPRB, 0.539540E-02_JPRB, 0.495194E-02_JPRB, 0.454492E-02_JPRB, & - & 0.417136E-02_JPRB, 0.382850E-02_JPRB, 0.351382E-02_JPRB, 0.322501E-02_JPRB, 0.295993E-02_JPRB /) + & 0.417136E-02_JPRB, 0.382850E-02_JPRB, 0.351382E-02_JPRB, 0.322501E-02_JPRB, 0.295993E-02_JPRB /) SELFREF(:,12) = (/ & & 0.677803E-02_JPRB, 0.615625E-02_JPRB, 0.559152E-02_JPRB, 0.507859E-02_JPRB, 0.461271E-02_JPRB, & - & 0.418957E-02_JPRB, 0.380524E-02_JPRB, 0.345617E-02_JPRB, 0.313913E-02_JPRB, 0.285116E-02_JPRB /) + & 0.418957E-02_JPRB, 0.380524E-02_JPRB, 0.345617E-02_JPRB, 0.313913E-02_JPRB, 0.285116E-02_JPRB /) SELFREF(:,13) = (/ & & 0.690347E-02_JPRB, 0.627003E-02_JPRB, 0.569472E-02_JPRB, 0.517219E-02_JPRB, 0.469761E-02_JPRB, & - & 0.426658E-02_JPRB, 0.387509E-02_JPRB, 0.351953E-02_JPRB, 0.319659E-02_JPRB, 0.290328E-02_JPRB /) + & 0.426658E-02_JPRB, 0.387509E-02_JPRB, 0.351953E-02_JPRB, 0.319659E-02_JPRB, 0.290328E-02_JPRB /) SELFREF(:,14) = (/ & & 0.692680E-02_JPRB, 0.632795E-02_JPRB, 0.578087E-02_JPRB, 0.528109E-02_JPRB, 0.482452E-02_JPRB, & - & 0.440742E-02_JPRB, 0.402638E-02_JPRB, 0.367828E-02_JPRB, 0.336028E-02_JPRB, 0.306977E-02_JPRB /) + & 0.440742E-02_JPRB, 0.402638E-02_JPRB, 0.367828E-02_JPRB, 0.336028E-02_JPRB, 0.306977E-02_JPRB /) SELFREF(:,15) = (/ & & 0.754894E-02_JPRB, 0.681481E-02_JPRB, 0.615207E-02_JPRB, 0.555378E-02_JPRB, 0.501367E-02_JPRB, & - & 0.452609E-02_JPRB, 0.408593E-02_JPRB, 0.368857E-02_JPRB, 0.332986E-02_JPRB, 0.300603E-02_JPRB /) + & 0.452609E-02_JPRB, 0.408593E-02_JPRB, 0.368857E-02_JPRB, 0.332986E-02_JPRB, 0.300603E-02_JPRB /) SELFREF(:,16) = (/ & & 0.760689E-02_JPRB, 0.709755E-02_JPRB, 0.662232E-02_JPRB, 0.617891E-02_JPRB, 0.576519E-02_JPRB, & - & 0.537917E-02_JPRB, 0.501899E-02_JPRB, 0.468293E-02_JPRB, 0.436938E-02_JPRB, 0.407682E-02_JPRB /) + & 0.537917E-02_JPRB, 0.501899E-02_JPRB, 0.468293E-02_JPRB, 0.436938E-02_JPRB, 0.407682E-02_JPRB /) IF (LHOOK) CALL DR_HOOK('SRTM_KGB16',1,ZHOOK_HANDLE) RETURN diff --git a/ifsrrtm/srtm_kgb17.F90 b/ifsrrtm/srtm_kgb17.F90 index cce6c8c2..c7337b88 100644 --- a/ifsrrtm/srtm_kgb17.F90 +++ b/ifsrrtm/srtm_kgb17.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_KGB17 ! Originally by J.Delamere, Atmospheric & Environmental Research. @@ -12,8 +21,8 @@ SUBROUTINE SRTM_KGB17 USE PARKIND1 , ONLY : JPRB USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN_ECRAD, ONLY : NULRAD -USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC +USE YOMLUN_ECRAD,ONLY : NULRAD +USE YOMMP0_IFSAUX,ONLY : NPROC, MYPROC USE MPL_MODULE, ONLY : MPL_BROADCAST USE YOMTAG , ONLY : MTAGRAD USE YOESRTA17 , ONLY : KA, KB, SELFREF, FORREF, SFLUXREF, RAYL, STRRAT, LAYREFFR, & @@ -44,32 +53,32 @@ SUBROUTINE SRTM_KGB17 & 3.15613_JPRB , 3.03449_JPRB , 2.92069_JPRB , 2.63874_JPRB , & & 2.34581_JPRB , 2.06999_JPRB , 1.70906_JPRB , 1.29085_JPRB , & & 0.874851_JPRB , 0.0955392_JPRB, 0.0787813_JPRB, 0.0621951_JPRB , & - & 0.0459076_JPRB, 0.0294129_JPRB, 0.0110387_JPRB, 0.00159668_JPRB /) - + & 0.0459076_JPRB, 0.0294129_JPRB, 0.0110387_JPRB, 0.00159668_JPRB /) + SFLUXREF(:,2) = (/ & & 2.83147_JPRB , 2.95919_JPRB , 2.96674_JPRB , 2.77677_JPRB , & & 2.46826_JPRB , 2.11481_JPRB , 1.73243_JPRB , 1.30279_JPRB , & & 0.882714_JPRB , 0.0962350_JPRB, 0.0802122_JPRB, 0.0636194_JPRB , & - & 0.0472620_JPRB, 0.0299051_JPRB, 0.0110785_JPRB, 0.00159668_JPRB /) - + & 0.0472620_JPRB, 0.0299051_JPRB, 0.0110785_JPRB, 0.00159668_JPRB /) + SFLUXREF(:,3) = (/ & & 2.82300_JPRB , 2.94845_JPRB , 2.95887_JPRB , 2.77593_JPRB , & & 2.47096_JPRB , 2.12596_JPRB , 1.73847_JPRB , 1.30796_JPRB , & & 0.884395_JPRB , 0.0966936_JPRB, 0.0801996_JPRB, 0.0640199_JPRB , & - & 0.0472803_JPRB, 0.0300515_JPRB, 0.0112366_JPRB, 0.00160814_JPRB /) - + & 0.0472803_JPRB, 0.0300515_JPRB, 0.0112366_JPRB, 0.00160814_JPRB /) + SFLUXREF(:,4) = (/ & & 2.81715_JPRB , 2.93789_JPRB , 2.95091_JPRB , 2.77046_JPRB , & & 2.47716_JPRB , 2.13591_JPRB , 1.74365_JPRB , 1.31277_JPRB , & & 0.887443_JPRB , 0.0967016_JPRB, 0.0803391_JPRB, 0.0642442_JPRB , & - & 0.0472909_JPRB, 0.0300720_JPRB, 0.0114817_JPRB, 0.00161875_JPRB /) - + & 0.0472909_JPRB, 0.0300720_JPRB, 0.0114817_JPRB, 0.00161875_JPRB /) + SFLUXREF(:,5) = (/ & & 2.82335_JPRB , 2.93168_JPRB , 2.91455_JPRB , 2.75213_JPRB , & & 2.49168_JPRB , 2.14408_JPRB , 1.75726_JPRB , 1.32401_JPRB , & & 0.893644_JPRB , 0.0969523_JPRB, 0.0805197_JPRB, 0.0639936_JPRB , & - & 0.0475099_JPRB, 0.0305667_JPRB, 0.0115372_JPRB, 0.00161875_JPRB /) - + & 0.0475099_JPRB, 0.0305667_JPRB, 0.0115372_JPRB, 0.00161875_JPRB /) + ! Rayleigh extinction coefficient at v = 3625 cm-1. RAYL = 6.86E-10_JPRB @@ -79,12 +88,12 @@ SUBROUTINE SRTM_KGB17 ! ------------------------------------------------------------------ -! The array KA contains absorption coefs at the 16 chosen g-values +! The array KA contains absorption coefs at the 16 chosen g-values ! for a range of pressure levels> ~100mb, temperatures, and binary -! species parameters (see taumol.f for definition). The first -! index in the array, JS, runs from 1 to 9, and corresponds to -! different values of the binary species parameter. For instance, -! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, +! species parameters (see taumol.f for definition). The first +! index in the array, JS, runs from 1 to 9, and corresponds to +! different values of the binary species parameter. For instance, +! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, ! JS = 3 corresponds to the parameter value 2/8, etc. The second index ! in the array, JT, which runs from 1 to 5, corresponds to different ! temperatures. More specifically, JT = 3 means that the data are for @@ -97,13 +106,13 @@ SUBROUTINE SRTM_KGB17 ! ----------------------------------------------------------------- ! ----------------------------------------------------------------- -! The array KB contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure +! The array KB contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure ! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. ! The second index, JP, runs from 13 to 59 and refers to the JPth ! reference pressure level (see taumol.f for the value of these ! pressure levels in mb). The third index, IG, goes from 1 to 16, @@ -137,52 +146,52 @@ SUBROUTINE SRTM_KGB17 SELFREF(:, 1) = (/ & & 0.160537E-01_JPRB, 0.149038E-01_JPRB, 0.138363E-01_JPRB, 0.128452E-01_JPRB, 0.119251E-01_JPRB, & - & 0.110709E-01_JPRB, 0.102779E-01_JPRB, 0.954175E-02_JPRB, 0.885829E-02_JPRB, 0.822379E-02_JPRB /) + & 0.110709E-01_JPRB, 0.102779E-01_JPRB, 0.954175E-02_JPRB, 0.885829E-02_JPRB, 0.822379E-02_JPRB /) SELFREF(:, 2) = (/ & & 0.365753E-01_JPRB, 0.342267E-01_JPRB, 0.320288E-01_JPRB, 0.299720E-01_JPRB, 0.280474E-01_JPRB, & - & 0.262463E-01_JPRB, 0.245609E-01_JPRB, 0.229837E-01_JPRB, 0.215078E-01_JPRB, 0.201267E-01_JPRB /) + & 0.262463E-01_JPRB, 0.245609E-01_JPRB, 0.229837E-01_JPRB, 0.215078E-01_JPRB, 0.201267E-01_JPRB /) SELFREF(:, 3) = (/ & & 0.127419E+00_JPRB, 0.118553E+00_JPRB, 0.110304E+00_JPRB, 0.102629E+00_JPRB, 0.954883E-01_JPRB, & - & 0.888442E-01_JPRB, 0.826624E-01_JPRB, 0.769107E-01_JPRB, 0.715593E-01_JPRB, 0.665802E-01_JPRB /) + & 0.888442E-01_JPRB, 0.826624E-01_JPRB, 0.769107E-01_JPRB, 0.715593E-01_JPRB, 0.665802E-01_JPRB /) SELFREF(:, 4) = (/ & & 0.378687E+00_JPRB, 0.348961E+00_JPRB, 0.321568E+00_JPRB, 0.296325E+00_JPRB, 0.273064E+00_JPRB, & - & 0.251629E+00_JPRB, 0.231876E+00_JPRB, 0.213674E+00_JPRB, 0.196901E+00_JPRB, 0.181444E+00_JPRB /) + & 0.251629E+00_JPRB, 0.231876E+00_JPRB, 0.213674E+00_JPRB, 0.196901E+00_JPRB, 0.181444E+00_JPRB /) SELFREF(:, 5) = (/ & & 0.472822E+00_JPRB, 0.435018E+00_JPRB, 0.400236E+00_JPRB, 0.368236E+00_JPRB, 0.338794E+00_JPRB, & - & 0.311706E+00_JPRB, 0.286783E+00_JPRB, 0.263854E+00_JPRB, 0.242757E+00_JPRB, 0.223348E+00_JPRB /) + & 0.311706E+00_JPRB, 0.286783E+00_JPRB, 0.263854E+00_JPRB, 0.242757E+00_JPRB, 0.223348E+00_JPRB /) SELFREF(:, 6) = (/ & & 0.505620E+00_JPRB, 0.465050E+00_JPRB, 0.427736E+00_JPRB, 0.393416E+00_JPRB, 0.361849E+00_JPRB, & - & 0.332815E+00_JPRB, 0.306111E+00_JPRB, 0.281550E+00_JPRB, 0.258959E+00_JPRB, 0.238181E+00_JPRB /) + & 0.332815E+00_JPRB, 0.306111E+00_JPRB, 0.281550E+00_JPRB, 0.258959E+00_JPRB, 0.238181E+00_JPRB /) SELFREF(:, 7) = (/ & & 0.530488E+00_JPRB, 0.487993E+00_JPRB, 0.448902E+00_JPRB, 0.412943E+00_JPRB, 0.379864E+00_JPRB, & - & 0.349434E+00_JPRB, 0.321443E+00_JPRB, 0.295694E+00_JPRB, 0.272007E+00_JPRB, 0.250218E+00_JPRB /) + & 0.349434E+00_JPRB, 0.321443E+00_JPRB, 0.295694E+00_JPRB, 0.272007E+00_JPRB, 0.250218E+00_JPRB /) SELFREF(:, 8) = (/ & & 0.540222E+00_JPRB, 0.497746E+00_JPRB, 0.458610E+00_JPRB, 0.422551E+00_JPRB, 0.389327E+00_JPRB, & - & 0.358716E+00_JPRB, 0.330511E+00_JPRB, 0.304524E+00_JPRB, 0.280580E+00_JPRB, 0.258519E+00_JPRB /) + & 0.358716E+00_JPRB, 0.330511E+00_JPRB, 0.304524E+00_JPRB, 0.280580E+00_JPRB, 0.258519E+00_JPRB /) SELFREF(:, 9) = (/ & & 0.565727E+00_JPRB, 0.522899E+00_JPRB, 0.483313E+00_JPRB, 0.446724E+00_JPRB, 0.412905E+00_JPRB, & - & 0.381646E+00_JPRB, 0.352753E+00_JPRB, 0.326048E+00_JPRB, 0.301365E+00_JPRB, 0.278550E+00_JPRB /) + & 0.381646E+00_JPRB, 0.352753E+00_JPRB, 0.326048E+00_JPRB, 0.301365E+00_JPRB, 0.278550E+00_JPRB /) SELFREF(:,10) = (/ & & 0.610122E+00_JPRB, 0.562337E+00_JPRB, 0.518295E+00_JPRB, 0.477702E+00_JPRB, 0.440289E+00_JPRB, & - & 0.405806E+00_JPRB, 0.374023E+00_JPRB, 0.344730E+00_JPRB, 0.317730E+00_JPRB, 0.292846E+00_JPRB /) + & 0.405806E+00_JPRB, 0.374023E+00_JPRB, 0.344730E+00_JPRB, 0.317730E+00_JPRB, 0.292846E+00_JPRB /) SELFREF(:,11) = (/ & & 0.645176E+00_JPRB, 0.588957E+00_JPRB, 0.537636E+00_JPRB, 0.490788E+00_JPRB, 0.448022E+00_JPRB, & - & 0.408982E+00_JPRB, 0.373344E+00_JPRB, 0.340812E+00_JPRB, 0.311114E+00_JPRB, 0.284004E+00_JPRB /) + & 0.408982E+00_JPRB, 0.373344E+00_JPRB, 0.340812E+00_JPRB, 0.311114E+00_JPRB, 0.284004E+00_JPRB /) SELFREF(:,12) = (/ & & 0.651737E+00_JPRB, 0.596547E+00_JPRB, 0.546031E+00_JPRB, 0.499792E+00_JPRB, 0.457469E+00_JPRB, & - & 0.418730E+00_JPRB, 0.383272E+00_JPRB, 0.350816E+00_JPRB, 0.321108E+00_JPRB, 0.293916E+00_JPRB /) + & 0.418730E+00_JPRB, 0.383272E+00_JPRB, 0.350816E+00_JPRB, 0.321108E+00_JPRB, 0.293916E+00_JPRB /) SELFREF(:,13) = (/ & & 0.661086E+00_JPRB, 0.607954E+00_JPRB, 0.559093E+00_JPRB, 0.514159E+00_JPRB, 0.472836E+00_JPRB, & - & 0.434834E+00_JPRB, 0.399886E+00_JPRB, 0.367747E+00_JPRB, 0.338191E+00_JPRB, 0.311011E+00_JPRB /) + & 0.434834E+00_JPRB, 0.399886E+00_JPRB, 0.367747E+00_JPRB, 0.338191E+00_JPRB, 0.311011E+00_JPRB /) SELFREF(:,14) = (/ & & 0.692554E+00_JPRB, 0.635574E+00_JPRB, 0.583282E+00_JPRB, 0.535293E+00_JPRB, 0.491251E+00_JPRB, & - & 0.450834E+00_JPRB, 0.413741E+00_JPRB, 0.379701E+00_JPRB, 0.348461E+00_JPRB, 0.319791E+00_JPRB /) + & 0.450834E+00_JPRB, 0.413741E+00_JPRB, 0.379701E+00_JPRB, 0.348461E+00_JPRB, 0.319791E+00_JPRB /) SELFREF(:,15) = (/ & & 0.714646E+00_JPRB, 0.657179E+00_JPRB, 0.604334E+00_JPRB, 0.555737E+00_JPRB, 0.511049E+00_JPRB, & - & 0.469954E+00_JPRB, 0.432164E+00_JPRB, 0.397412E+00_JPRB, 0.365455E+00_JPRB, 0.336068E+00_JPRB /) + & 0.469954E+00_JPRB, 0.432164E+00_JPRB, 0.397412E+00_JPRB, 0.365455E+00_JPRB, 0.336068E+00_JPRB /) SELFREF(:,16) = (/ & & 0.782126E+00_JPRB, 0.710682E+00_JPRB, 0.645764E+00_JPRB, 0.586776E+00_JPRB, 0.533177E+00_JPRB, & - & 0.484473E+00_JPRB, 0.440219E+00_JPRB, 0.400007E+00_JPRB, 0.363468E+00_JPRB, 0.330266E+00_JPRB /) + & 0.484473E+00_JPRB, 0.440219E+00_JPRB, 0.400007E+00_JPRB, 0.363468E+00_JPRB, 0.330266E+00_JPRB /) IF (LHOOK) CALL DR_HOOK('SRTM_KGB17',1,ZHOOK_HANDLE) RETURN diff --git a/ifsrrtm/srtm_kgb18.F90 b/ifsrrtm/srtm_kgb18.F90 index e2c8ae2f..dce35f47 100644 --- a/ifsrrtm/srtm_kgb18.F90 +++ b/ifsrrtm/srtm_kgb18.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_KGB18 ! Originally by J.Delamere, Atmospheric & Environmental Research. @@ -12,12 +21,12 @@ SUBROUTINE SRTM_KGB18 USE PARKIND1 , ONLY : JPRB USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN_ECRAD, ONLY : NULRAD -USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC +USE YOMLUN_ECRAD,ONLY : NULRAD +USE YOMMP0_IFSAUX,ONLY : NPROC, MYPROC USE MPL_MODULE, ONLY : MPL_BROADCAST USE YOMTAG , ONLY : MTAGRAD USE YOESRTA18 , ONLY : KA, KB, SELFREF, FORREF, SFLUXREF, RAYL, STRRAT, LAYREFFR, & - & KA_D, KB_D + & KA_D, KB_D ! ------------------------------------------------------------------ @@ -44,47 +53,47 @@ SUBROUTINE SRTM_KGB18 & 3.65840_JPRB , 3.54375_JPRB , 3.34481_JPRB , 3.10534_JPRB , & & 2.79879_JPRB , 2.42841_JPRB , 1.98748_JPRB , 1.49377_JPRB , & & 1.00196_JPRB , 0.108342_JPRB , 8.95099E-02_JPRB, 7.05199E-02_JPRB, & - & 5.16432E-02_JPRB, 3.27635E-02_JPRB, 1.25133E-02_JPRB, 1.73001E-03_JPRB /) + & 5.16432E-02_JPRB, 3.27635E-02_JPRB, 1.25133E-02_JPRB, 1.73001E-03_JPRB /) SFLUXREF(:,2) = (/ & & 3.86372_JPRB , 3.48521_JPRB , 3.30790_JPRB , 3.08103_JPRB , & & 2.77552_JPRB , 2.40722_JPRB , 1.97307_JPRB , 1.48023_JPRB , & & 0.993055_JPRB , 0.107691_JPRB , 8.84430E-02_JPRB, 6.99354E-02_JPRB, & - & 5.07881E-02_JPRB, 3.24121E-02_JPRB, 1.19442E-02_JPRB, 1.57612E-03_JPRB /) + & 5.07881E-02_JPRB, 3.24121E-02_JPRB, 1.19442E-02_JPRB, 1.57612E-03_JPRB /) SFLUXREF(:,3) = (/ & & 3.90370_JPRB , 3.50657_JPRB , 3.30629_JPRB , 3.06046_JPRB , & & 2.76982_JPRB , 2.39907_JPRB , 1.96358_JPRB , 1.47458_JPRB , & & 0.988475_JPRB , 0.106698_JPRB , 8.75242E-02_JPRB, 6.85898E-02_JPRB, & - & 5.04798E-02_JPRB, 3.13718E-02_JPRB, 1.09533E-02_JPRB, 1.57612E-03_JPRB /) + & 5.04798E-02_JPRB, 3.13718E-02_JPRB, 1.09533E-02_JPRB, 1.57612E-03_JPRB /) SFLUXREF(:,4) = (/ & & 3.93165_JPRB , 3.52058_JPRB , 3.31346_JPRB , 3.04944_JPRB , & & 2.76074_JPRB , 2.39433_JPRB , 1.95556_JPRB , 1.46712_JPRB , & & 0.984056_JPRB , 0.105885_JPRB , 8.73062E-02_JPRB, 6.84054E-02_JPRB, & - & 4.87443E-02_JPRB, 2.99295E-02_JPRB, 1.09533E-02_JPRB, 1.57612E-03_JPRB /) + & 4.87443E-02_JPRB, 2.99295E-02_JPRB, 1.09533E-02_JPRB, 1.57612E-03_JPRB /) SFLUXREF(:,5) = (/ & & 3.94082_JPRB , 3.55221_JPRB , 3.31863_JPRB , 3.04730_JPRB , & & 2.74918_JPRB , 2.38328_JPRB , 1.95212_JPRB , 1.45889_JPRB , & & 0.978888_JPRB , 0.105102_JPRB , 8.65732E-02_JPRB, 6.74563E-02_JPRB, & - & 4.76592E-02_JPRB, 2.91017E-02_JPRB, 1.09533E-02_JPRB, 1.57612E-03_JPRB /) + & 4.76592E-02_JPRB, 2.91017E-02_JPRB, 1.09533E-02_JPRB, 1.57612E-03_JPRB /) SFLUXREF(:,6) = (/ & & 3.94198_JPRB , 3.58743_JPRB , 3.32106_JPRB , 3.05866_JPRB , & & 2.74115_JPRB , 2.36939_JPRB , 1.94305_JPRB , 1.45180_JPRB , & & 0.971784_JPRB , 1.04045E-01_JPRB, 8.53731E-02_JPRB, 6.60654E-02_JPRB, & - & 4.63228E-02_JPRB, 2.91016E-02_JPRB, 1.09552E-02_JPRB, 1.57612E-03_JPRB /) + & 4.63228E-02_JPRB, 2.91016E-02_JPRB, 1.09552E-02_JPRB, 1.57612E-03_JPRB /) SFLUXREF(:,7) = (/ & & 3.93596_JPRB , 3.63366_JPRB , 3.33144_JPRB , 3.06252_JPRB , & & 2.74054_JPRB , 2.35492_JPRB , 1.92769_JPRB , 1.44300_JPRB , & & 0.961809_JPRB , 1.02867E-01_JPRB, 8.34164E-02_JPRB, 6.41005E-02_JPRB, & - & 4.61826E-02_JPRB, 2.91006E-02_JPRB, 1.09553E-02_JPRB, 1.57612E-03_JPRB /) + & 4.61826E-02_JPRB, 2.91006E-02_JPRB, 1.09553E-02_JPRB, 1.57612E-03_JPRB /) SFLUXREF(:,8) = (/ & & 3.92520_JPRB , 3.69078_JPRB , 3.35656_JPRB , 3.07055_JPRB , & & 2.73862_JPRB , 2.34430_JPRB , 1.90187_JPRB , 1.42242_JPRB , & & 0.946676_JPRB , 9.96302E-02_JPRB, 8.14421E-02_JPRB, 6.38622E-02_JPRB, & - & 4.61794E-02_JPRB, 2.91017E-02_JPRB, 1.09553E-02_JPRB, 1.57612E-03_JPRB /) + & 4.61794E-02_JPRB, 2.91017E-02_JPRB, 1.09553E-02_JPRB, 1.57612E-03_JPRB /) SFLUXREF(:,9) = (/ & & 3.80721_JPRB , 3.74437_JPRB , 3.50205_JPRB , 3.18009_JPRB , & & 2.75757_JPRB , 2.29188_JPRB , 1.84382_JPRB , 1.35694_JPRB , & & 0.914040_JPRB , 9.86811E-02_JPRB, 8.14321E-02_JPRB, 6.38541E-02_JPRB, & - & 4.61795E-02_JPRB, 2.90960E-02_JPRB, 1.09613E-02_JPRB, 1.57612E-03_JPRB /) + & 4.61795E-02_JPRB, 2.90960E-02_JPRB, 1.09613E-02_JPRB, 1.57612E-03_JPRB /) ! Rayleigh extinction coefficient at v = 4325 cm-1. RAYL = 1.39E-09_JPRB @@ -95,12 +104,12 @@ SUBROUTINE SRTM_KGB18 ! ------------------------------------------------------------------ -! The array KA contains absorption coefs at the 16 chosen g-values +! The array KA contains absorption coefs at the 16 chosen g-values ! for a range of pressure levels> ~100mb, temperatures, and binary -! species parameters (see taumol.f for definition). The first -! index in the array, JS, runs from 1 to 9, and corresponds to -! different values of the binary species parameter. For instance, -! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, +! species parameters (see taumol.f for definition). The first +! index in the array, JS, runs from 1 to 9, and corresponds to +! different values of the binary species parameter. For instance, +! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, ! JS = 3 corresponds to the parameter value 2/8, etc. The second index ! in the array, JT, which runs from 1 to 5, corresponds to different ! temperatures. More specifically, JT = 3 means that the data are for @@ -113,20 +122,20 @@ SUBROUTINE SRTM_KGB18 ! ----------------------------------------------------------------- ! ----------------------------------------------------------------- -! The array KB contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure +! The array KB contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure ! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. ! The second index, JP, runs from 13 to 59 and refers to the JPth ! reference pressure level (see taumol.f for the value of these ! pressure levels in mb). The third index, IG, goes from 1 to 16, ! and tells us which g-interval the absorption coefficients are for. ! ----------------------------------------------------------------- - + FORREF(:, 1) = (/ 0.860560E-06_JPRB, 0.130439E-05_JPRB, 0.382378E-05_JPRB /) FORREF(:, 2) = (/ 0.817926E-06_JPRB, 0.158599E-05_JPRB, 0.658771E-04_JPRB /) FORREF(:, 3) = (/ 0.129369E-05_JPRB, 0.824406E-05_JPRB, 0.952778E-04_JPRB /) @@ -150,55 +159,55 @@ SUBROUTINE SRTM_KGB18 ! refers to temperature in 7.2 degree increments. For instance, ! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, ! etc. The second index runs over the g-channel (1 to 16). - + SELFREF(:, 1) = (/ & & 0.750370E-03_JPRB, 0.644938E-03_JPRB, 0.554321E-03_JPRB, 0.476436E-03_JPRB, 0.409494E-03_JPRB, & - & 0.351957E-03_JPRB, 0.302505E-03_JPRB, 0.260002E-03_JPRB, 0.223470E-03_JPRB, 0.192071E-03_JPRB /) + & 0.351957E-03_JPRB, 0.302505E-03_JPRB, 0.260002E-03_JPRB, 0.223470E-03_JPRB, 0.192071E-03_JPRB /) SELFREF(:, 2) = (/ & & 0.136135E-02_JPRB, 0.113187E-02_JPRB, 0.941076E-03_JPRB, 0.782440E-03_JPRB, 0.650546E-03_JPRB, & - & 0.540885E-03_JPRB, 0.449709E-03_JPRB, 0.373902E-03_JPRB, 0.310874E-03_JPRB, 0.258471E-03_JPRB /) + & 0.540885E-03_JPRB, 0.449709E-03_JPRB, 0.373902E-03_JPRB, 0.310874E-03_JPRB, 0.258471E-03_JPRB /) SELFREF(:, 3) = (/ & & 0.333950E-02_JPRB, 0.256391E-02_JPRB, 0.196845E-02_JPRB, 0.151129E-02_JPRB, 0.116030E-02_JPRB, & - & 0.890824E-03_JPRB, 0.683934E-03_JPRB, 0.525093E-03_JPRB, 0.403143E-03_JPRB, 0.309515E-03_JPRB /) + & 0.890824E-03_JPRB, 0.683934E-03_JPRB, 0.525093E-03_JPRB, 0.403143E-03_JPRB, 0.309515E-03_JPRB /) SELFREF(:, 4) = (/ & & 0.793392E-02_JPRB, 0.589865E-02_JPRB, 0.438548E-02_JPRB, 0.326048E-02_JPRB, 0.242408E-02_JPRB, & - & 0.180223E-02_JPRB, 0.133991E-02_JPRB, 0.996186E-03_JPRB, 0.740636E-03_JPRB, 0.550642E-03_JPRB /) + & 0.180223E-02_JPRB, 0.133991E-02_JPRB, 0.996186E-03_JPRB, 0.740636E-03_JPRB, 0.550642E-03_JPRB /) SELFREF(:, 5) = (/ & & 0.828169E-02_JPRB, 0.703139E-02_JPRB, 0.596984E-02_JPRB, 0.506856E-02_JPRB, 0.430335E-02_JPRB, & - & 0.365366E-02_JPRB, 0.310206E-02_JPRB, 0.263374E-02_JPRB, 0.223612E-02_JPRB, 0.189852E-02_JPRB /) + & 0.365366E-02_JPRB, 0.310206E-02_JPRB, 0.263374E-02_JPRB, 0.223612E-02_JPRB, 0.189852E-02_JPRB /) SELFREF(:, 6) = (/ & & 0.834190E-02_JPRB, 0.780225E-02_JPRB, 0.729750E-02_JPRB, 0.682541E-02_JPRB, 0.638386E-02_JPRB, & - & 0.597087E-02_JPRB, 0.558460E-02_JPRB, 0.522332E-02_JPRB, 0.488541E-02_JPRB, 0.456936E-02_JPRB /) + & 0.597087E-02_JPRB, 0.558460E-02_JPRB, 0.522332E-02_JPRB, 0.488541E-02_JPRB, 0.456936E-02_JPRB /) SELFREF(:, 7) = (/ & & 0.119082E-01_JPRB, 0.112566E-01_JPRB, 0.106406E-01_JPRB, 0.100583E-01_JPRB, 0.950785E-02_JPRB, & - & 0.898755E-02_JPRB, 0.849571E-02_JPRB, 0.803080E-02_JPRB, 0.759132E-02_JPRB, 0.717590E-02_JPRB /) + & 0.898755E-02_JPRB, 0.849571E-02_JPRB, 0.803080E-02_JPRB, 0.759132E-02_JPRB, 0.717590E-02_JPRB /) SELFREF(:, 8) = (/ & & 0.144004E-01_JPRB, 0.141762E-01_JPRB, 0.139554E-01_JPRB, 0.137381E-01_JPRB, 0.135241E-01_JPRB, & - & 0.133135E-01_JPRB, 0.131062E-01_JPRB, 0.129021E-01_JPRB, 0.127011E-01_JPRB, 0.125033E-01_JPRB /) + & 0.133135E-01_JPRB, 0.131062E-01_JPRB, 0.129021E-01_JPRB, 0.127011E-01_JPRB, 0.125033E-01_JPRB /) SELFREF(:, 9) = (/ & & 0.186171E-01_JPRB, 0.175281E-01_JPRB, 0.165027E-01_JPRB, 0.155373E-01_JPRB, 0.146284E-01_JPRB, & - & 0.137726E-01_JPRB, 0.129670E-01_JPRB, 0.122084E-01_JPRB, 0.114942E-01_JPRB, 0.108218E-01_JPRB /) + & 0.137726E-01_JPRB, 0.129670E-01_JPRB, 0.122084E-01_JPRB, 0.114942E-01_JPRB, 0.108218E-01_JPRB /) SELFREF(:,10) = (/ & & 0.209396E-01_JPRB, 0.195077E-01_JPRB, 0.181737E-01_JPRB, 0.169309E-01_JPRB, 0.157731E-01_JPRB, & - & 0.146945E-01_JPRB, 0.136897E-01_JPRB, 0.127535E-01_JPRB, 0.118814E-01_JPRB, 0.110689E-01_JPRB /) + & 0.146945E-01_JPRB, 0.136897E-01_JPRB, 0.127535E-01_JPRB, 0.118814E-01_JPRB, 0.110689E-01_JPRB /) SELFREF(:,11) = (/ & & 0.203661E-01_JPRB, 0.193311E-01_JPRB, 0.183487E-01_JPRB, 0.174163E-01_JPRB, 0.165312E-01_JPRB, & - & 0.156911E-01_JPRB, 0.148937E-01_JPRB, 0.141368E-01_JPRB, 0.134184E-01_JPRB, 0.127365E-01_JPRB /) + & 0.156911E-01_JPRB, 0.148937E-01_JPRB, 0.141368E-01_JPRB, 0.134184E-01_JPRB, 0.127365E-01_JPRB /) SELFREF(:,12) = (/ & & 0.226784E-01_JPRB, 0.210210E-01_JPRB, 0.194848E-01_JPRB, 0.180608E-01_JPRB, 0.167409E-01_JPRB, & - & 0.155174E-01_JPRB, 0.143834E-01_JPRB, 0.133322E-01_JPRB, 0.123579E-01_JPRB, 0.114547E-01_JPRB /) + & 0.155174E-01_JPRB, 0.143834E-01_JPRB, 0.133322E-01_JPRB, 0.123579E-01_JPRB, 0.114547E-01_JPRB /) SELFREF(:,13) = (/ & & 0.221773E-01_JPRB, 0.210306E-01_JPRB, 0.199433E-01_JPRB, 0.189122E-01_JPRB, 0.179344E-01_JPRB, & - & 0.170071E-01_JPRB, 0.161278E-01_JPRB, 0.152939E-01_JPRB, 0.145032E-01_JPRB, 0.137533E-01_JPRB /) + & 0.170071E-01_JPRB, 0.161278E-01_JPRB, 0.152939E-01_JPRB, 0.145032E-01_JPRB, 0.137533E-01_JPRB /) SELFREF(:,14) = (/ & & 0.275920E-01_JPRB, 0.252595E-01_JPRB, 0.231241E-01_JPRB, 0.211693E-01_JPRB, 0.193797E-01_JPRB, & - & 0.177415E-01_JPRB, 0.162417E-01_JPRB, 0.148687E-01_JPRB, 0.136117E-01_JPRB, 0.124610E-01_JPRB /) + & 0.177415E-01_JPRB, 0.162417E-01_JPRB, 0.148687E-01_JPRB, 0.136117E-01_JPRB, 0.124610E-01_JPRB /) SELFREF(:,15) = (/ & & 0.288687E-01_JPRB, 0.269968E-01_JPRB, 0.252462E-01_JPRB, 0.236092E-01_JPRB, 0.220783E-01_JPRB, & - & 0.206466E-01_JPRB, 0.193078E-01_JPRB, 0.180559E-01_JPRB, 0.168851E-01_JPRB, 0.157902E-01_JPRB /) + & 0.206466E-01_JPRB, 0.193078E-01_JPRB, 0.180559E-01_JPRB, 0.168851E-01_JPRB, 0.157902E-01_JPRB /) SELFREF(:,16) = (/ & & 0.371842E-01_JPRB, 0.347595E-01_JPRB, 0.324929E-01_JPRB, 0.303741E-01_JPRB, 0.283934E-01_JPRB, & - & 0.265419E-01_JPRB, 0.248112E-01_JPRB, 0.231933E-01_JPRB, 0.216809E-01_JPRB, 0.202671E-01_JPRB /) + & 0.265419E-01_JPRB, 0.248112E-01_JPRB, 0.231933E-01_JPRB, 0.216809E-01_JPRB, 0.202671E-01_JPRB /) IF (LHOOK) CALL DR_HOOK('SRTM_KGB18',1,ZHOOK_HANDLE) RETURN diff --git a/ifsrrtm/srtm_kgb19.F90 b/ifsrrtm/srtm_kgb19.F90 index 21352a36..f1724a90 100644 --- a/ifsrrtm/srtm_kgb19.F90 +++ b/ifsrrtm/srtm_kgb19.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_KGB19 ! Originally by J.Delamere, Atmospheric & Environmental Research. @@ -12,8 +21,8 @@ SUBROUTINE SRTM_KGB19 USE PARKIND1 , ONLY : JPRB USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN_ECRAD, ONLY : NULRAD -USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC +USE YOMLUN_ECRAD,ONLY : NULRAD +USE YOMMP0_IFSAUX,ONLY : NPROC, MYPROC USE MPL_MODULE, ONLY : MPL_BROADCAST USE YOMTAG , ONLY : MTAGRAD USE YOESRTA19 , ONLY : KA, KB, SELFREF, FORREF, SFLUXREF, RAYL, STRRAT, LAYREFFR, & @@ -44,47 +53,47 @@ SUBROUTINE SRTM_KGB19 & 3.25791_JPRB , 3.29697_JPRB , 3.16031_JPRB , 2.96115_JPRB , & & 2.69238_JPRB , 2.33819_JPRB , 1.92760_JPRB , 1.44918_JPRB , & & 0.979764_JPRB , 0.107336_JPRB , 8.94523E-02_JPRB, 6.98325E-02_JPRB, & - & 5.12051E-02_JPRB, 3.23645E-02_JPRB, 1.23401E-02_JPRB, 1.71339E-03_JPRB /) + & 5.12051E-02_JPRB, 3.23645E-02_JPRB, 1.23401E-02_JPRB, 1.71339E-03_JPRB /) SFLUXREF(:,2) = (/ & & 3.22769_JPRB , 3.28817_JPRB , 3.16687_JPRB , 2.97662_JPRB , & & 2.69495_JPRB , 2.34392_JPRB , 1.92900_JPRB , 1.45391_JPRB , & & 0.982522_JPRB , 0.107638_JPRB , 8.92458E-02_JPRB, 6.99885E-02_JPRB, & - & 5.09679E-02_JPRB, 3.23789E-02_JPRB, 1.22673E-02_JPRB, 1.56040E-03_JPRB /) + & 5.09679E-02_JPRB, 3.23789E-02_JPRB, 1.22673E-02_JPRB, 1.56040E-03_JPRB /) SFLUXREF(:,3) = (/ & & 3.22294_JPRB , 3.27780_JPRB , 3.17424_JPRB , 2.97143_JPRB , & & 2.69785_JPRB , 2.34993_JPRB , 1.93155_JPRB , 1.45196_JPRB , & & 0.985329_JPRB , 0.108027_JPRB , 8.93552E-02_JPRB, 6.99937E-02_JPRB, & - & 5.11678E-02_JPRB, 3.24846E-02_JPRB, 1.20636E-02_JPRB, 1.56040E-03_JPRB /) + & 5.11678E-02_JPRB, 3.24846E-02_JPRB, 1.20636E-02_JPRB, 1.56040E-03_JPRB /) SFLUXREF(:,4) = (/ & & 3.22445_JPRB , 3.26113_JPRB , 3.18438_JPRB , 2.96921_JPRB , & & 2.69579_JPRB , 2.35586_JPRB , 1.93454_JPRB , 1.44949_JPRB , & & 0.987347_JPRB , 0.108611_JPRB , 8.91643E-02_JPRB, 7.02236E-02_JPRB, & - & 5.12980E-02_JPRB, 3.25282E-02_JPRB, 1.21189E-02_JPRB, 1.56040E-03_JPRB /) + & 5.12980E-02_JPRB, 3.25282E-02_JPRB, 1.21189E-02_JPRB, 1.56040E-03_JPRB /) SFLUXREF(:,5) = (/ & & 3.22497_JPRB , 3.25109_JPRB , 3.18741_JPRB , 2.96970_JPRB , & & 2.69460_JPRB , 2.36020_JPRB , 1.93301_JPRB , 1.45224_JPRB , & & 0.988564_JPRB , 0.108255_JPRB , 8.93830E-02_JPRB, 7.03655E-02_JPRB, & - & 5.13017E-02_JPRB, 3.29414E-02_JPRB, 1.21189E-02_JPRB, 1.56040E-03_JPRB /) + & 5.13017E-02_JPRB, 3.29414E-02_JPRB, 1.21189E-02_JPRB, 1.56040E-03_JPRB /) SFLUXREF(:,6) = (/ & & 3.22632_JPRB , 3.24174_JPRB , 3.18524_JPRB , 2.97402_JPRB , & & 2.69807_JPRB , 2.35742_JPRB , 1.93377_JPRB , 1.45621_JPRB , & & 0.988132_JPRB , 0.108344_JPRB , 8.93188E-02_JPRB, 7.04907E-02_JPRB, & - & 5.17938E-02_JPRB, 3.31465E-02_JPRB, 1.21155E-02_JPRB, 1.56040E-03_JPRB /) + & 5.17938E-02_JPRB, 3.31465E-02_JPRB, 1.21155E-02_JPRB, 1.56040E-03_JPRB /) SFLUXREF(:,7) = (/ & & 3.22793_JPRB , 3.23589_JPRB , 3.17720_JPRB , 2.97869_JPRB , & & 2.70293_JPRB , 2.35436_JPRB , 1.93557_JPRB , 1.45868_JPRB , & & 0.988654_JPRB , 0.108198_JPRB , 8.93375E-02_JPRB, 7.09790E-02_JPRB, & - & 5.24733E-02_JPRB, 3.31298E-02_JPRB, 1.21126E-02_JPRB, 1.56040E-03_JPRB /) + & 5.24733E-02_JPRB, 3.31298E-02_JPRB, 1.21126E-02_JPRB, 1.56040E-03_JPRB /) SFLUXREF(:,8) = (/ & & 3.22966_JPRB , 3.24087_JPRB , 3.15676_JPRB , 2.98171_JPRB , & & 2.70894_JPRB , 2.34975_JPRB , 1.93855_JPRB , 1.46354_JPRB , & & 0.988544_JPRB , 0.108574_JPRB , 9.02522E-02_JPRB, 7.12908E-02_JPRB, & - & 5.24844E-02_JPRB, 3.31084E-02_JPRB, 1.21060E-02_JPRB, 1.56040E-03_JPRB /) + & 5.24844E-02_JPRB, 3.31084E-02_JPRB, 1.21060E-02_JPRB, 1.56040E-03_JPRB /) SFLUXREF(:,9) = (/ & & 3.27240_JPRB , 3.24666_JPRB , 3.13886_JPRB , 2.95238_JPRB , & & 2.70190_JPRB , 2.34460_JPRB , 1.93948_JPRB , 1.47111_JPRB , & & 0.990821_JPRB , 0.108730_JPRB , 9.01625E-02_JPRB, 7.13261E-02_JPRB, & - & 5.24813E-02_JPRB, 3.31083E-02_JPRB, 1.21126E-02_JPRB, 1.56040E-03_JPRB /) + & 5.24813E-02_JPRB, 3.31083E-02_JPRB, 1.21126E-02_JPRB, 1.56040E-03_JPRB /) ! Rayleigh extinction coefficient at v = 4900 cm-1. RAYL = 2.29E-09_JPRB @@ -95,12 +104,12 @@ SUBROUTINE SRTM_KGB19 ! ------------------------------------------------------------------ -! The array KA contains absorption coefs at the 16 chosen g-values +! The array KA contains absorption coefs at the 16 chosen g-values ! for a range of pressure levels> ~100mb, temperatures, and binary -! species parameters (see taumol.f for definition). The first -! index in the array, JS, runs from 1 to 9, and corresponds to -! different values of the binary species parameter. For instance, -! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, +! species parameters (see taumol.f for definition). The first +! index in the array, JS, runs from 1 to 9, and corresponds to +! different values of the binary species parameter. For instance, +! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, ! JS = 3 corresponds to the parameter value 2/8, etc. The second index ! in the array, JT, which runs from 1 to 5, corresponds to different ! temperatures. More specifically, JT = 3 means that the data are for @@ -113,20 +122,20 @@ SUBROUTINE SRTM_KGB19 ! ----------------------------------------------------------------- ! ----------------------------------------------------------------- -! The array KB contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure +! The array KB contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure ! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. ! The second index, JP, runs from 13 to 59 and refers to the JPth ! reference pressure level (see taumol.f for the value of these ! pressure levels in mb). The third index, IG, goes from 1 to 16, ! and tells us which g-interval the absorption coefficients are for. ! ----------------------------------------------------------------- - + FORREF(:, 1) = (/ 0.106275E-05_JPRB, 0.104185E-05_JPRB, 0.420154E-05_JPRB /) FORREF(:, 2) = (/ 0.154343E-05_JPRB, 0.653193E-05_JPRB, 0.174596E-04_JPRB /) FORREF(:, 3) = (/ 0.348917E-05_JPRB, 0.108420E-04_JPRB, 0.540849E-04_JPRB /) @@ -150,55 +159,55 @@ SUBROUTINE SRTM_KGB19 ! refers to temperature in 7.2 degree increments. For instance, ! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, ! etc. The second index runs over the g-channel (1 to 16). - + SELFREF(:, 1) = (/ & & 0.331728E-03_JPRB, 0.287480E-03_JPRB, 0.249135E-03_JPRB, 0.215904E-03_JPRB, 0.187106E-03_JPRB, & - & 0.162149E-03_JPRB, 0.140520E-03_JPRB, 0.121777E-03_JPRB, 0.105534E-03_JPRB, 0.914573E-04_JPRB /) + & 0.162149E-03_JPRB, 0.140520E-03_JPRB, 0.121777E-03_JPRB, 0.105534E-03_JPRB, 0.914573E-04_JPRB /) SELFREF(:, 2) = (/ & & 0.882628E-03_JPRB, 0.698914E-03_JPRB, 0.553439E-03_JPRB, 0.438244E-03_JPRB, 0.347026E-03_JPRB, & - & 0.274795E-03_JPRB, 0.217598E-03_JPRB, 0.172306E-03_JPRB, 0.136442E-03_JPRB, 0.108042E-03_JPRB /) + & 0.274795E-03_JPRB, 0.217598E-03_JPRB, 0.172306E-03_JPRB, 0.136442E-03_JPRB, 0.108042E-03_JPRB /) SELFREF(:, 3) = (/ & & 0.115461E-02_JPRB, 0.937203E-03_JPRB, 0.760730E-03_JPRB, 0.617486E-03_JPRB, 0.501215E-03_JPRB, & - & 0.406837E-03_JPRB, 0.330231E-03_JPRB, 0.268049E-03_JPRB, 0.217576E-03_JPRB, 0.176607E-03_JPRB /) + & 0.406837E-03_JPRB, 0.330231E-03_JPRB, 0.268049E-03_JPRB, 0.217576E-03_JPRB, 0.176607E-03_JPRB /) SELFREF(:, 4) = (/ & & 0.103450E-02_JPRB, 0.960268E-03_JPRB, 0.891360E-03_JPRB, 0.827397E-03_JPRB, 0.768024E-03_JPRB, & - & 0.712911E-03_JPRB, 0.661754E-03_JPRB, 0.614267E-03_JPRB, 0.570188E-03_JPRB, 0.529272E-03_JPRB /) + & 0.712911E-03_JPRB, 0.661754E-03_JPRB, 0.614267E-03_JPRB, 0.570188E-03_JPRB, 0.529272E-03_JPRB /) SELFREF(:, 5) = (/ & & 0.289040E-02_JPRB, 0.240129E-02_JPRB, 0.199495E-02_JPRB, 0.165737E-02_JPRB, 0.137692E-02_JPRB, & - & 0.114392E-02_JPRB, 0.950351E-03_JPRB, 0.789535E-03_JPRB, 0.655933E-03_JPRB, 0.544938E-03_JPRB /) + & 0.114392E-02_JPRB, 0.950351E-03_JPRB, 0.789535E-03_JPRB, 0.655933E-03_JPRB, 0.544938E-03_JPRB /) SELFREF(:, 6) = (/ & & 0.361772E-02_JPRB, 0.306611E-02_JPRB, 0.259861E-02_JPRB, 0.220239E-02_JPRB, 0.186659E-02_JPRB, & - & 0.158198E-02_JPRB, 0.134077E-02_JPRB, 0.113634E-02_JPRB, 0.963078E-03_JPRB, 0.816234E-03_JPRB /) + & 0.158198E-02_JPRB, 0.134077E-02_JPRB, 0.113634E-02_JPRB, 0.963078E-03_JPRB, 0.816234E-03_JPRB /) SELFREF(:, 7) = (/ & & 0.329878E-02_JPRB, 0.318245E-02_JPRB, 0.307021E-02_JPRB, 0.296194E-02_JPRB, 0.285749E-02_JPRB, & - & 0.275671E-02_JPRB, 0.265950E-02_JPRB, 0.256571E-02_JPRB, 0.247522E-02_JPRB, 0.238793E-02_JPRB /) + & 0.275671E-02_JPRB, 0.265950E-02_JPRB, 0.256571E-02_JPRB, 0.247522E-02_JPRB, 0.238793E-02_JPRB /) SELFREF(:, 8) = (/ & & 0.293562E-02_JPRB, 0.300077E-02_JPRB, 0.306737E-02_JPRB, 0.313544E-02_JPRB, 0.320503E-02_JPRB, & - & 0.327615E-02_JPRB, 0.334886E-02_JPRB, 0.342318E-02_JPRB, 0.349915E-02_JPRB, 0.357680E-02_JPRB /) + & 0.327615E-02_JPRB, 0.334886E-02_JPRB, 0.342318E-02_JPRB, 0.349915E-02_JPRB, 0.357680E-02_JPRB /) SELFREF(:, 9) = (/ & & 0.281453E-02_JPRB, 0.295894E-02_JPRB, 0.311076E-02_JPRB, 0.327038E-02_JPRB, 0.343818E-02_JPRB, & - & 0.361459E-02_JPRB, 0.380006E-02_JPRB, 0.399504E-02_JPRB, 0.420002E-02_JPRB, 0.441553E-02_JPRB /) + & 0.361459E-02_JPRB, 0.380006E-02_JPRB, 0.399504E-02_JPRB, 0.420002E-02_JPRB, 0.441553E-02_JPRB /) SELFREF(:,10) = (/ & & 0.239488E-02_JPRB, 0.262487E-02_JPRB, 0.287696E-02_JPRB, 0.315325E-02_JPRB, 0.345607E-02_JPRB, & - & 0.378798E-02_JPRB, 0.415176E-02_JPRB, 0.455048E-02_JPRB, 0.498749E-02_JPRB, 0.546647E-02_JPRB /) + & 0.378798E-02_JPRB, 0.415176E-02_JPRB, 0.455048E-02_JPRB, 0.498749E-02_JPRB, 0.546647E-02_JPRB /) SELFREF(:,11) = (/ & & 0.271001E-02_JPRB, 0.292235E-02_JPRB, 0.315134E-02_JPRB, 0.339826E-02_JPRB, 0.366453E-02_JPRB, & - & 0.395167E-02_JPRB, 0.426131E-02_JPRB, 0.459521E-02_JPRB, 0.495527E-02_JPRB, 0.534354E-02_JPRB /) + & 0.395167E-02_JPRB, 0.426131E-02_JPRB, 0.459521E-02_JPRB, 0.495527E-02_JPRB, 0.534354E-02_JPRB /) SELFREF(:,12) = (/ & & 0.206702E-02_JPRB, 0.232254E-02_JPRB, 0.260966E-02_JPRB, 0.293226E-02_JPRB, 0.329475E-02_JPRB, & - & 0.370204E-02_JPRB, 0.415969E-02_JPRB, 0.467391E-02_JPRB, 0.525169E-02_JPRB, 0.590090E-02_JPRB /) + & 0.370204E-02_JPRB, 0.415969E-02_JPRB, 0.467391E-02_JPRB, 0.525169E-02_JPRB, 0.590090E-02_JPRB /) SELFREF(:,13) = (/ & & 0.227023E-02_JPRB, 0.257331E-02_JPRB, 0.291685E-02_JPRB, 0.330626E-02_JPRB, 0.374766E-02_JPRB, & - & 0.424799E-02_JPRB, 0.481511E-02_JPRB, 0.545794E-02_JPRB, 0.618660E-02_JPRB, 0.701253E-02_JPRB /) + & 0.424799E-02_JPRB, 0.481511E-02_JPRB, 0.545794E-02_JPRB, 0.618660E-02_JPRB, 0.701253E-02_JPRB /) SELFREF(:,14) = (/ & & 0.851078E-03_JPRB, 0.111512E-02_JPRB, 0.146109E-02_JPRB, 0.191439E-02_JPRB, 0.250832E-02_JPRB, & - & 0.328653E-02_JPRB, 0.430617E-02_JPRB, 0.564215E-02_JPRB, 0.739261E-02_JPRB, 0.968616E-02_JPRB /) + & 0.328653E-02_JPRB, 0.430617E-02_JPRB, 0.564215E-02_JPRB, 0.739261E-02_JPRB, 0.968616E-02_JPRB /) SELFREF(:,15) = (/ & & 0.742711E-02_JPRB, 0.721347E-02_JPRB, 0.700598E-02_JPRB, 0.680446E-02_JPRB, 0.660873E-02_JPRB, & - & 0.641863E-02_JPRB, 0.623400E-02_JPRB, 0.605468E-02_JPRB, 0.588052E-02_JPRB, 0.571137E-02_JPRB /) + & 0.641863E-02_JPRB, 0.623400E-02_JPRB, 0.605468E-02_JPRB, 0.588052E-02_JPRB, 0.571137E-02_JPRB /) SELFREF(:,16) = (/ & & 0.107170E-01_JPRB, 0.101913E-01_JPRB, 0.969138E-02_JPRB, 0.921599E-02_JPRB, 0.876392E-02_JPRB, & - & 0.833402E-02_JPRB, 0.792521E-02_JPRB, 0.753646E-02_JPRB, 0.716677E-02_JPRB, 0.681522E-02_JPRB /) + & 0.833402E-02_JPRB, 0.792521E-02_JPRB, 0.753646E-02_JPRB, 0.716677E-02_JPRB, 0.681522E-02_JPRB /) IF (LHOOK) CALL DR_HOOK('SRTM_KGB19',1,ZHOOK_HANDLE) RETURN diff --git a/ifsrrtm/srtm_kgb20.F90 b/ifsrrtm/srtm_kgb20.F90 index ca2d878e..6df8b727 100644 --- a/ifsrrtm/srtm_kgb20.F90 +++ b/ifsrrtm/srtm_kgb20.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_KGB20 ! Originally by J.Delamere, Atmospheric & Environmental Research. @@ -11,8 +20,8 @@ SUBROUTINE SRTM_KGB20 USE PARKIND1 , ONLY : JPRB USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN_ECRAD, ONLY : NULRAD -USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC +USE YOMLUN_ECRAD,ONLY : NULRAD +USE YOMMP0_IFSAUX,ONLY : NPROC, MYPROC USE MPL_MODULE, ONLY : MPL_BROADCAST USE YOMTAG , ONLY : MTAGRAD USE YOESRTA20 , ONLY : KA, KB, SELFREF, FORREF, SFLUXREF, RAYL, ABSCH4, LAYREFFR ,& @@ -43,13 +52,13 @@ SUBROUTINE SRTM_KGB20 & 9.34081_JPRB , 8.93720_JPRB , 8.19346_JPRB , 7.39196_JPRB , & & 6.12127_JPRB , 5.23956_JPRB , 4.24941_JPRB , 3.20013_JPRB , & & 2.16047_JPRB , 0.234509_JPRB , 0.194593_JPRB , 0.151512_JPRB , & - & 0.110315_JPRB, 7.09959E-02_JPRB, 2.70573E-02_JPRB, 3.36042E-03_JPRB /) - + & 0.110315_JPRB, 7.09959E-02_JPRB, 2.70573E-02_JPRB, 3.36042E-03_JPRB /) + ABSCH4 = (/ & & 1.01381E-03_JPRB,6.33692E-03_JPRB,1.94185E-02_JPRB,4.83210E-02_JPRB, & & 2.36574E-03_JPRB,6.61973E-04_JPRB,5.64552E-04_JPRB,2.83183E-04_JPRB, & & 7.43623E-05_JPRB,8.90159E-07_JPRB,6.98728E-07_JPRB,6.51832E-08_JPRB, & - & 2.96619E-08_JPRB, 0._JPRB, 0._JPRB, 0._JPRB /) + & 2.96619E-08_JPRB, 0._JPRB, 0._JPRB, 0._JPRB /) ! Rayleigh extinction coefficient at v = 5670 cm-1. RAYL = 4.12E-09_JPRB @@ -58,12 +67,12 @@ SUBROUTINE SRTM_KGB20 ! ------------------------------------------------------------------ -! The array KA contains absorption coefs at the 16 chosen g-values +! The array KA contains absorption coefs at the 16 chosen g-values ! for a range of pressure levels> ~100mb, temperatures, and binary -! species parameters (see taumol.f for definition). The first -! index in the array, JS, runs from 1 to 9, and corresponds to -! different values of the binary species parameter. For instance, -! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, +! species parameters (see taumol.f for definition). The first +! index in the array, JS, runs from 1 to 9, and corresponds to +! different values of the binary species parameter. For instance, +! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, ! JS = 3 corresponds to the parameter value 2/8, etc. The second index ! in the array, JT, which runs from 1 to 5, corresponds to different ! temperatures. More specifically, JT = 3 means that the data are for @@ -76,13 +85,13 @@ SUBROUTINE SRTM_KGB20 ! ----------------------------------------------------------------- ! ----------------------------------------------------------------- -! The array KB contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure +! The array KB contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure ! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. ! The second index, JP, runs from 13 to 59 and refers to the JPth ! reference pressure level (see taumol.f for the value of these ! pressure levels in mb). The third index, IG, goes from 1 to 16, @@ -116,53 +125,53 @@ SUBROUTINE SRTM_KGB20 SELFREF(:, 1) = (/ & & 0.217058E-03_JPRB, 0.176391E-03_JPRB, 0.143342E-03_JPRB, 0.116486E-03_JPRB, 0.946614E-04_JPRB, & - & 0.769257E-04_JPRB, 0.625131E-04_JPRB, 0.508007E-04_JPRB, 0.412828E-04_JPRB, 0.335481E-04_JPRB /) + & 0.769257E-04_JPRB, 0.625131E-04_JPRB, 0.508007E-04_JPRB, 0.412828E-04_JPRB, 0.335481E-04_JPRB /) SELFREF(:, 2) = (/ & & 0.598055E-03_JPRB, 0.484805E-03_JPRB, 0.393000E-03_JPRB, 0.318580E-03_JPRB, 0.258252E-03_JPRB, & - & 0.209348E-03_JPRB, 0.169705E-03_JPRB, 0.137569E-03_JPRB, 0.111518E-03_JPRB, 0.904008E-04_JPRB /) + & 0.209348E-03_JPRB, 0.169705E-03_JPRB, 0.137569E-03_JPRB, 0.111518E-03_JPRB, 0.904008E-04_JPRB /) SELFREF(:, 3) = (/ & & 0.102691E-02_JPRB, 0.930281E-03_JPRB, 0.842740E-03_JPRB, 0.763437E-03_JPRB, 0.691596E-03_JPRB, & - & 0.626516E-03_JPRB, 0.567560E-03_JPRB, 0.514152E-03_JPRB, 0.465769E-03_JPRB, 0.421940E-03_JPRB /) + & 0.626516E-03_JPRB, 0.567560E-03_JPRB, 0.514152E-03_JPRB, 0.465769E-03_JPRB, 0.421940E-03_JPRB /) SELFREF(:, 4) = (/ & & 0.388569E-02_JPRB, 0.365098E-02_JPRB, 0.343045E-02_JPRB, 0.322324E-02_JPRB, 0.302854E-02_JPRB, & - & 0.284561E-02_JPRB, 0.267372E-02_JPRB, 0.251222E-02_JPRB, 0.236047E-02_JPRB, 0.221789E-02_JPRB /) + & 0.284561E-02_JPRB, 0.267372E-02_JPRB, 0.251222E-02_JPRB, 0.236047E-02_JPRB, 0.221789E-02_JPRB /) SELFREF(:, 5) = (/ & & 0.349845E-01_JPRB, 0.326678E-01_JPRB, 0.305045E-01_JPRB, 0.284845E-01_JPRB, 0.265982E-01_JPRB, & - & 0.248369E-01_JPRB, 0.231921E-01_JPRB, 0.216563E-01_JPRB, 0.202222E-01_JPRB, 0.188831E-01_JPRB /) + & 0.248369E-01_JPRB, 0.231921E-01_JPRB, 0.216563E-01_JPRB, 0.202222E-01_JPRB, 0.188831E-01_JPRB /) SELFREF(:, 6) = (/ & & 0.613705E-01_JPRB, 0.562676E-01_JPRB, 0.515890E-01_JPRB, 0.472994E-01_JPRB, 0.433665E-01_JPRB, & - & 0.397606E-01_JPRB, 0.364545E-01_JPRB, 0.334233E-01_JPRB, 0.306442E-01_JPRB, 0.280961E-01_JPRB /) + & 0.397606E-01_JPRB, 0.364545E-01_JPRB, 0.334233E-01_JPRB, 0.306442E-01_JPRB, 0.280961E-01_JPRB /) SELFREF(:, 7) = (/ & & 0.656981E-01_JPRB, 0.602660E-01_JPRB, 0.552830E-01_JPRB, 0.507120E-01_JPRB, 0.465190E-01_JPRB, & - & 0.426726E-01_JPRB, 0.391443E-01_JPRB, 0.359077E-01_JPRB, 0.329387E-01_JPRB, 0.302153E-01_JPRB /) + & 0.426726E-01_JPRB, 0.391443E-01_JPRB, 0.359077E-01_JPRB, 0.329387E-01_JPRB, 0.302153E-01_JPRB /) SELFREF(:, 8) = (/ & & 0.671782E-01_JPRB, 0.616461E-01_JPRB, 0.565695E-01_JPRB, 0.519110E-01_JPRB, 0.476361E-01_JPRB, & - & 0.437132E-01_JPRB, 0.401134E-01_JPRB, 0.368100E-01_JPRB, 0.337787E-01_JPRB, 0.309970E-01_JPRB /) + & 0.437132E-01_JPRB, 0.401134E-01_JPRB, 0.368100E-01_JPRB, 0.337787E-01_JPRB, 0.309970E-01_JPRB /) SELFREF(:, 9) = (/ & & 0.675902E-01_JPRB, 0.620888E-01_JPRB, 0.570351E-01_JPRB, 0.523928E-01_JPRB, 0.481284E-01_JPRB, & - & 0.442110E-01_JPRB, 0.406125E-01_JPRB, 0.373069E-01_JPRB, 0.342703E-01_JPRB, 0.314809E-01_JPRB /) + & 0.442110E-01_JPRB, 0.406125E-01_JPRB, 0.373069E-01_JPRB, 0.342703E-01_JPRB, 0.314809E-01_JPRB /) SELFREF(:,10) = (/ & & 0.708308E-01_JPRB, 0.651419E-01_JPRB, 0.599099E-01_JPRB, 0.550981E-01_JPRB, 0.506728E-01_JPRB, & - & 0.466030E-01_JPRB, 0.428600E-01_JPRB, 0.394176E-01_JPRB, 0.362517E-01_JPRB, 0.333401E-01_JPRB /) + & 0.466030E-01_JPRB, 0.428600E-01_JPRB, 0.394176E-01_JPRB, 0.362517E-01_JPRB, 0.333401E-01_JPRB /) SELFREF(:,11) = (/ & & 0.698445E-01_JPRB, 0.646584E-01_JPRB, 0.598573E-01_JPRB, 0.554128E-01_JPRB, 0.512982E-01_JPRB, & - & 0.474892E-01_JPRB, 0.439630E-01_JPRB, 0.406986E-01_JPRB, 0.376766E-01_JPRB, 0.348791E-01_JPRB /) + & 0.474892E-01_JPRB, 0.439630E-01_JPRB, 0.406986E-01_JPRB, 0.376766E-01_JPRB, 0.348791E-01_JPRB /) SELFREF(:,12) = (/ & & 0.743921E-01_JPRB, 0.682057E-01_JPRB, 0.625337E-01_JPRB, 0.573334E-01_JPRB, 0.525655E-01_JPRB, & - & 0.481942E-01_JPRB, 0.441863E-01_JPRB, 0.405118E-01_JPRB, 0.371428E-01_JPRB, 0.340540E-01_JPRB /) + & 0.481942E-01_JPRB, 0.441863E-01_JPRB, 0.405118E-01_JPRB, 0.371428E-01_JPRB, 0.340540E-01_JPRB /) SELFREF(:,13) = (/ & & 0.775758E-01_JPRB, 0.709818E-01_JPRB, 0.649484E-01_JPRB, 0.594277E-01_JPRB, 0.543764E-01_JPRB, & - & 0.497544E-01_JPRB, 0.455253E-01_JPRB, 0.416556E-01_JPRB, 0.381149E-01_JPRB, 0.348751E-01_JPRB /) + & 0.497544E-01_JPRB, 0.455253E-01_JPRB, 0.416556E-01_JPRB, 0.381149E-01_JPRB, 0.348751E-01_JPRB /) SELFREF(:,14) = (/ & & 0.776545E-01_JPRB, 0.714761E-01_JPRB, 0.657894E-01_JPRB, 0.605550E-01_JPRB, 0.557372E-01_JPRB, & - & 0.513026E-01_JPRB, 0.472209E-01_JPRB, 0.434639E-01_JPRB, 0.400058E-01_JPRB, 0.368229E-01_JPRB /) + & 0.513026E-01_JPRB, 0.472209E-01_JPRB, 0.434639E-01_JPRB, 0.400058E-01_JPRB, 0.368229E-01_JPRB /) SELFREF(:,15) = (/ & & 0.855675E-01_JPRB, 0.787337E-01_JPRB, 0.724456E-01_JPRB, 0.666598E-01_JPRB, 0.613360E-01_JPRB, & - & 0.564374E-01_JPRB, 0.519301E-01_JPRB, 0.477827E-01_JPRB, 0.439666E-01_JPRB, 0.404552E-01_JPRB /) + & 0.564374E-01_JPRB, 0.519301E-01_JPRB, 0.477827E-01_JPRB, 0.439666E-01_JPRB, 0.404552E-01_JPRB /) SELFREF(:,16) = (/ & & 0.934781E-01_JPRB, 0.855190E-01_JPRB, 0.782376E-01_JPRB, 0.715761E-01_JPRB, 0.654819E-01_JPRB, & - & 0.599065E-01_JPRB, 0.548058E-01_JPRB, 0.501394E-01_JPRB, 0.458704E-01_JPRB, 0.419648E-01_JPRB /) - + & 0.599065E-01_JPRB, 0.548058E-01_JPRB, 0.501394E-01_JPRB, 0.458704E-01_JPRB, 0.419648E-01_JPRB /) + ! ----------------------------------------------------------------- IF (LHOOK) CALL DR_HOOK('SRTM_KGB20',1,ZHOOK_HANDLE) diff --git a/ifsrrtm/srtm_kgb21.F90 b/ifsrrtm/srtm_kgb21.F90 index 967d1656..e979fe41 100644 --- a/ifsrrtm/srtm_kgb21.F90 +++ b/ifsrrtm/srtm_kgb21.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_KGB21 ! Originally by J.Delamere, Atmospheric & Environmental Research. @@ -12,8 +21,8 @@ SUBROUTINE SRTM_KGB21 USE PARKIND1 , ONLY : JPRB USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN_ECRAD, ONLY : NULRAD -USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC +USE YOMLUN_ECRAD,ONLY : NULRAD +USE YOMMP0_IFSAUX,ONLY : NPROC, MYPROC USE MPL_MODULE, ONLY : MPL_BROADCAST USE YOMTAG , ONLY : MTAGRAD USE YOESRTA21 , ONLY : KA, KB, SELFREF, FORREF, SFLUXREF, RAYL, STRRAT, LAYREFFR ,& @@ -44,47 +53,47 @@ SUBROUTINE SRTM_KGB21 & 16.1643_JPRB , 15.5806_JPRB, 14.7254_JPRB , 13.5541_JPRB , & & 11.9519_JPRB ,10.44410_JPRB, 8.37884_JPRB , 6.26384_JPRB , & & 4.28435_JPRB ,0.465228_JPRB, 0.385095_JPRB ,0.304226_JPRB , & - & 0.222479_JPRB,0.143286_JPRB, 5.58046E-02_JPRB, 7.84856E-03_JPRB /) + & 0.222479_JPRB,0.143286_JPRB, 5.58046E-02_JPRB, 7.84856E-03_JPRB /) SFLUXREF(:, 2) = (/ & & 15.6451_JPRB , 15.3170_JPRB, 14.6987_JPRB , 13.7350_JPRB , & & 12.2267_JPRB ,10.51646_JPRB, 8.47150_JPRB , 6.38873_JPRB , & & 4.33536_JPRB ,0.470610_JPRB,0.389426_JPRB ,0.306461_JPRB , & - & 0.223537_JPRB,0.143273_JPRB, 5.58179E-02_JPRB, 7.84856E-03_JPRB /) + & 0.223537_JPRB,0.143273_JPRB, 5.58179E-02_JPRB, 7.84856E-03_JPRB /) SFLUXREF(:, 3) = (/ & & 15.6092_JPRB , 15.3293_JPRB, 14.6881_JPRB , 13.6693_JPRB , & & 12.2342_JPRB ,10.52010_JPRB, 8.49442_JPRB , 6.42138_JPRB , & & 4.35865_JPRB ,0.473349_JPRB,0.391349_JPRB ,0.308861_JPRB , & - & 0.224666_JPRB,0.144799_JPRB, 5.58176E-02_JPRB, 7.84881E-03_JPRB /) + & 0.224666_JPRB,0.144799_JPRB, 5.58176E-02_JPRB, 7.84881E-03_JPRB /) SFLUXREF(:, 4) = (/ & & 15.5786_JPRB , 15.3422_JPRB, 14.6894_JPRB , 13.6040_JPRB , & & 12.2567_JPRB ,10.49400_JPRB, 8.53521_JPRB , 6.44427_JPRB , & & 4.37208_JPRB ,0.475709_JPRB,0.392956_JPRB ,0.309737_JPRB , & - & 0.226274_JPRB,0.146483_JPRB, 5.59325E-02_JPRB, 7.84881E-03_JPRB /) + & 0.226274_JPRB,0.146483_JPRB, 5.59325E-02_JPRB, 7.84881E-03_JPRB /) SFLUXREF(:, 5) = (/ & & 15.5380_JPRB , 15.3826_JPRB, 14.6575_JPRB , 13.5722_JPRB , & & 12.2646_JPRB ,10.47672_JPRB, 8.57158_JPRB , 6.46343_JPRB , & & 4.38259_JPRB ,0.477647_JPRB,0.393982_JPRB ,0.310686_JPRB , & - & 0.227620_JPRB,0.148376_JPRB, 5.60398E-02_JPRB, 7.83925E-03_JPRB /) + & 0.227620_JPRB,0.148376_JPRB, 5.60398E-02_JPRB, 7.83925E-03_JPRB /) SFLUXREF(:, 6) = (/ & & 15.5124_JPRB , 15.3986_JPRB, 14.6240_JPRB , 13.5535_JPRB , & & 12.2468_JPRB ,10.48891_JPRB, 8.60434_JPRB , 6.47985_JPRB , & & 4.39448_JPRB ,0.478267_JPRB,0.395618_JPRB ,0.311043_JPRB , & - & 0.230927_JPRB,0.148774_JPRB, 5.61189E-02_JPRB, 7.83925E-03_JPRB /) + & 0.230927_JPRB,0.148774_JPRB, 5.61189E-02_JPRB, 7.83925E-03_JPRB /) SFLUXREF(:, 7) = (/ & & 15.4910_JPRB , 15.4028_JPRB, 14.5772_JPRB , 13.5507_JPRB , & & 12.2122_JPRB ,10.52735_JPRB, 8.62650_JPRB , 6.49644_JPRB , & & 4.41173_JPRB ,0.478627_JPRB,0.396433_JPRB ,0.314199_JPRB , & - & 0.233125_JPRB,0.149052_JPRB, 5.62309E-02_JPRB, 7.83925E-03_JPRB /) + & 0.233125_JPRB,0.149052_JPRB, 5.62309E-02_JPRB, 7.83925E-03_JPRB /) SFLUXREF(:, 8) = (/ & & 15.4562_JPRB , 15.3928_JPRB, 14.5510_JPRB , 13.5122_JPRB , & & 12.1890_JPRB , 10.5826_JPRB, 8.65842_JPRB , 6.51558_JPRB , & & 4.42747_JPRB ,0.480669_JPRB,0.400143_JPRB ,0.318144_JPRB , & - & 0.233937_JPRB,0.149119_JPRB, 5.62309E-02_JPRB, 7.83925E-03_JPRB /) + & 0.233937_JPRB,0.149119_JPRB, 5.62309E-02_JPRB, 7.83925E-03_JPRB /) SFLUXREF(:, 9) = (/ & & 15.0069_JPRB , 15.1479_JPRB, 14.7802_JPRB , 13.6085_JPRB , & & 12.2793_JPRB , 10.6929_JPRB, 8.72723_JPRB , 6.57114_JPRB , & & 4.46330_JPRB ,0.486724_JPRB,0.401446_JPRB ,0.318879_JPRB , & - & 0.233959_JPRB,0.149119_JPRB, 5.62309E-02_JPRB, 7.83925E-03_JPRB /) + & 0.233959_JPRB,0.149119_JPRB, 5.62309E-02_JPRB, 7.83925E-03_JPRB /) ! Rayleigh extinction coefficient at v = 6925 cm-1. RAYL = 9.41E-09_JPRB @@ -95,12 +104,12 @@ SUBROUTINE SRTM_KGB21 ! ------------------------------------------------------------------ -! The array KA contains absorption coefs at the 16 chosen g-values +! The array KA contains absorption coefs at the 16 chosen g-values ! for a range of pressure levels> ~100mb, temperatures, and binary -! species parameters (see taumol.f for definition). The first -! index in the array, JS, runs from 1 to 9, and corresponds to -! different values of the binary species parameter. For instance, -! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, +! species parameters (see taumol.f for definition). The first +! index in the array, JS, runs from 1 to 9, and corresponds to +! different values of the binary species parameter. For instance, +! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, ! JS = 3 corresponds to the parameter value 2/8, etc. The second index ! in the array, JT, which runs from 1 to 5, corresponds to different ! temperatures. More specifically, JT = 3 means that the data are for @@ -113,13 +122,13 @@ SUBROUTINE SRTM_KGB21 ! ----------------------------------------------------------------- ! ----------------------------------------------------------------- -! The array KB contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure +! The array KB contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure ! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. ! The second index, JP, runs from 13 to 59 and refers to the JPth ! reference pressure level (see taumol.f for the value of these ! pressure levels in mb). The third index, IG, goes from 1 to 16, @@ -153,52 +162,52 @@ SUBROUTINE SRTM_KGB21 SELFREF(:, 1) = (/ & & 0.115887E-03_JPRB, 0.926537E-04_JPRB, 0.740783E-04_JPRB, 0.592270E-04_JPRB, 0.473530E-04_JPRB, & - & 0.378596E-04_JPRB, 0.302694E-04_JPRB, 0.242010E-04_JPRB, 0.193491E-04_JPRB, 0.154700E-04_JPRB /) + & 0.378596E-04_JPRB, 0.302694E-04_JPRB, 0.242010E-04_JPRB, 0.193491E-04_JPRB, 0.154700E-04_JPRB /) SELFREF(:, 2) = (/ & & 0.459557E-03_JPRB, 0.381962E-03_JPRB, 0.317469E-03_JPRB, 0.263866E-03_JPRB, 0.219313E-03_JPRB, & - & 0.182283E-03_JPRB, 0.151505E-03_JPRB, 0.125924E-03_JPRB, 0.104662E-03_JPRB, 0.869904E-04_JPRB /) + & 0.182283E-03_JPRB, 0.151505E-03_JPRB, 0.125924E-03_JPRB, 0.104662E-03_JPRB, 0.869904E-04_JPRB /) SELFREF(:, 3) = (/ & & 0.166821E-02_JPRB, 0.151103E-02_JPRB, 0.136866E-02_JPRB, 0.123970E-02_JPRB, 0.112290E-02_JPRB, & - & 0.101710E-02_JPRB, 0.921266E-03_JPRB, 0.834463E-03_JPRB, 0.755839E-03_JPRB, 0.684623E-03_JPRB /) + & 0.101710E-02_JPRB, 0.921266E-03_JPRB, 0.834463E-03_JPRB, 0.755839E-03_JPRB, 0.684623E-03_JPRB /) SELFREF(:, 4) = (/ & & 0.460175E-02_JPRB, 0.421372E-02_JPRB, 0.385842E-02_JPRB, 0.353307E-02_JPRB, 0.323516E-02_JPRB, & - & 0.296236E-02_JPRB, 0.271257E-02_JPRB, 0.248385E-02_JPRB, 0.227440E-02_JPRB, 0.208262E-02_JPRB /) + & 0.296236E-02_JPRB, 0.271257E-02_JPRB, 0.248385E-02_JPRB, 0.227440E-02_JPRB, 0.208262E-02_JPRB /) SELFREF(:, 5) = (/ & & 0.101589E-01_JPRB, 0.924742E-02_JPRB, 0.841772E-02_JPRB, 0.766247E-02_JPRB, 0.697497E-02_JPRB, & - & 0.634917E-02_JPRB, 0.577951E-02_JPRB, 0.526096E-02_JPRB, 0.478893E-02_JPRB, 0.435926E-02_JPRB /) + & 0.634917E-02_JPRB, 0.577951E-02_JPRB, 0.526096E-02_JPRB, 0.478893E-02_JPRB, 0.435926E-02_JPRB /) SELFREF(:, 6) = (/ & & 0.328043E-01_JPRB, 0.300853E-01_JPRB, 0.275917E-01_JPRB, 0.253048E-01_JPRB, 0.232075E-01_JPRB, & - & 0.212839E-01_JPRB, 0.195198E-01_JPRB, 0.179020E-01_JPRB, 0.164182E-01_JPRB, 0.150574E-01_JPRB /) + & 0.212839E-01_JPRB, 0.195198E-01_JPRB, 0.179020E-01_JPRB, 0.164182E-01_JPRB, 0.150574E-01_JPRB /) SELFREF(:, 7) = (/ & & 0.405936E-01_JPRB, 0.376032E-01_JPRB, 0.348331E-01_JPRB, 0.322671E-01_JPRB, 0.298901E-01_JPRB, & - & 0.276883E-01_JPRB, 0.256486E-01_JPRB, 0.237591E-01_JPRB, 0.220089E-01_JPRB, 0.203876E-01_JPRB /) + & 0.276883E-01_JPRB, 0.256486E-01_JPRB, 0.237591E-01_JPRB, 0.220089E-01_JPRB, 0.203876E-01_JPRB /) SELFREF(:, 8) = (/ & & 0.448362E-01_JPRB, 0.413811E-01_JPRB, 0.381923E-01_JPRB, 0.352492E-01_JPRB, 0.325329E-01_JPRB, & - & 0.300259E-01_JPRB, 0.277121E-01_JPRB, 0.255766E-01_JPRB, 0.236056E-01_JPRB, 0.217866E-01_JPRB /) + & 0.300259E-01_JPRB, 0.277121E-01_JPRB, 0.255766E-01_JPRB, 0.236056E-01_JPRB, 0.217866E-01_JPRB /) SELFREF(:, 9) = (/ & & 0.479741E-01_JPRB, 0.445389E-01_JPRB, 0.413497E-01_JPRB, 0.383889E-01_JPRB, 0.356400E-01_JPRB, & - & 0.330880E-01_JPRB, 0.307188E-01_JPRB, 0.285191E-01_JPRB, 0.264770E-01_JPRB, 0.245812E-01_JPRB /) + & 0.330880E-01_JPRB, 0.307188E-01_JPRB, 0.285191E-01_JPRB, 0.264770E-01_JPRB, 0.245812E-01_JPRB /) SELFREF(:,10) = (/ & & 0.519308E-01_JPRB, 0.484130E-01_JPRB, 0.451335E-01_JPRB, 0.420761E-01_JPRB, 0.392259E-01_JPRB, & - & 0.365687E-01_JPRB, 0.340916E-01_JPRB, 0.317822E-01_JPRB, 0.296293E-01_JPRB, 0.276222E-01_JPRB /) + & 0.365687E-01_JPRB, 0.340916E-01_JPRB, 0.317822E-01_JPRB, 0.296293E-01_JPRB, 0.276222E-01_JPRB /) SELFREF(:,11) = (/ & & 0.572039E-01_JPRB, 0.527780E-01_JPRB, 0.486945E-01_JPRB, 0.449270E-01_JPRB, 0.414510E-01_JPRB, & - & 0.382439E-01_JPRB, 0.352849E-01_JPRB, 0.325549E-01_JPRB, 0.300361E-01_JPRB, 0.277122E-01_JPRB /) + & 0.382439E-01_JPRB, 0.352849E-01_JPRB, 0.325549E-01_JPRB, 0.300361E-01_JPRB, 0.277122E-01_JPRB /) SELFREF(:,12) = (/ & & 0.601046E-01_JPRB, 0.554411E-01_JPRB, 0.511395E-01_JPRB, 0.471716E-01_JPRB, 0.435116E-01_JPRB, & - & 0.401356E-01_JPRB, 0.370215E-01_JPRB, 0.341490E-01_JPRB, 0.314994E-01_JPRB, 0.290554E-01_JPRB /) + & 0.401356E-01_JPRB, 0.370215E-01_JPRB, 0.341490E-01_JPRB, 0.314994E-01_JPRB, 0.290554E-01_JPRB /) SELFREF(:,13) = (/ & & 0.616595E-01_JPRB, 0.567145E-01_JPRB, 0.521662E-01_JPRB, 0.479826E-01_JPRB, 0.441346E-01_JPRB, & - & 0.405951E-01_JPRB, 0.373395E-01_JPRB, 0.343450E-01_JPRB, 0.315906E-01_JPRB, 0.290571E-01_JPRB /) + & 0.405951E-01_JPRB, 0.373395E-01_JPRB, 0.343450E-01_JPRB, 0.315906E-01_JPRB, 0.290571E-01_JPRB /) SELFREF(:,14) = (/ & & 0.647916E-01_JPRB, 0.592493E-01_JPRB, 0.541811E-01_JPRB, 0.495465E-01_JPRB, 0.453083E-01_JPRB, & - & 0.414326E-01_JPRB, 0.378885E-01_JPRB, 0.346475E-01_JPRB, 0.316837E-01_JPRB, 0.289735E-01_JPRB /) + & 0.414326E-01_JPRB, 0.378885E-01_JPRB, 0.346475E-01_JPRB, 0.316837E-01_JPRB, 0.289735E-01_JPRB /) SELFREF(:,15) = (/ & & 0.694231E-01_JPRB, 0.637703E-01_JPRB, 0.585777E-01_JPRB, 0.538079E-01_JPRB, 0.494265E-01_JPRB, & - & 0.454019E-01_JPRB, 0.417050E-01_JPRB, 0.383091E-01_JPRB, 0.351897E-01_JPRB, 0.323244E-01_JPRB /) + & 0.454019E-01_JPRB, 0.417050E-01_JPRB, 0.383091E-01_JPRB, 0.351897E-01_JPRB, 0.323244E-01_JPRB /) SELFREF(:,16) = (/ & & 0.761764E-01_JPRB, 0.701815E-01_JPRB, 0.646584E-01_JPRB, 0.595700E-01_JPRB, 0.548820E-01_JPRB, & - & 0.505629E-01_JPRB, 0.465838E-01_JPRB, 0.429178E-01_JPRB, 0.395403E-01_JPRB, 0.364286E-01_JPRB /) + & 0.505629E-01_JPRB, 0.465838E-01_JPRB, 0.429178E-01_JPRB, 0.395403E-01_JPRB, 0.364286E-01_JPRB /) IF (LHOOK) CALL DR_HOOK('SRTM_KGB21',1,ZHOOK_HANDLE) RETURN diff --git a/ifsrrtm/srtm_kgb22.F90 b/ifsrrtm/srtm_kgb22.F90 index 077f894c..4f41b1fb 100644 --- a/ifsrrtm/srtm_kgb22.F90 +++ b/ifsrrtm/srtm_kgb22.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_KGB22 ! Originally by J.Delamere, Atmospheric & Environmental Research. @@ -12,8 +21,8 @@ SUBROUTINE SRTM_KGB22 USE PARKIND1 , ONLY : JPRB USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN_ECRAD, ONLY : NULRAD -USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC +USE YOMLUN_ECRAD,ONLY : NULRAD +USE YOMMP0_IFSAUX,ONLY : NPROC, MYPROC USE MPL_MODULE, ONLY : MPL_BROADCAST USE YOMTAG , ONLY : MTAGRAD USE YOESRTA22 , ONLY : KA, KB, SELFREF, FORREF, SFLUXREF, RAYL, STRRAT, LAYREFFR ,& @@ -44,47 +53,47 @@ SUBROUTINE SRTM_KGB22 & 3.71641_JPRB ,3.63190_JPRB ,3.44795_JPRB ,3.17936_JPRB , & & 2.86071_JPRB ,2.48490_JPRB ,2.02471_JPRB ,1.52475_JPRB , & & 1.03811_JPRB ,0.113272_JPRB ,9.37115E-02_JPRB,7.38969E-02_JPRB, & - & 5.44713E-02_JPRB,3.45905E-02_JPRB,1.30293E-02_JPRB,1.84198E-03_JPRB /) + & 5.44713E-02_JPRB,3.45905E-02_JPRB,1.30293E-02_JPRB,1.84198E-03_JPRB /) SFLUXREF(:, 2) = (/ & & 3.73933_JPRB ,3.60360_JPRB ,3.43370_JPRB ,3.19749_JPRB , & & 2.87747_JPRB ,2.47926_JPRB ,2.02175_JPRB ,1.52010_JPRB , & & 1.03612_JPRB ,0.113265_JPRB ,9.37145E-02_JPRB,7.38951E-02_JPRB, & - & 5.44714E-02_JPRB,3.45906E-02_JPRB,1.30293E-02_JPRB,1.84198E-03_JPRB /) + & 5.44714E-02_JPRB,3.45906E-02_JPRB,1.30293E-02_JPRB,1.84198E-03_JPRB /) SFLUXREF(:, 3) = (/ & & 3.73889_JPRB ,3.60279_JPRB ,3.43404_JPRB ,3.20560_JPRB , & & 2.87367_JPRB ,2.47515_JPRB ,2.02412_JPRB ,1.52315_JPRB , & & 1.03146_JPRB ,0.113272_JPRB ,9.36707E-02_JPRB,7.39080E-02_JPRB, & - & 5.44598E-02_JPRB,3.45906E-02_JPRB,1.30293E-02_JPRB,1.84198E-03_JPRB /) + & 5.44598E-02_JPRB,3.45906E-02_JPRB,1.30293E-02_JPRB,1.84198E-03_JPRB /) SFLUXREF(:, 4) = (/ & & 3.73801_JPRB ,3.60530_JPRB ,3.43659_JPRB ,3.20640_JPRB , & & 2.87039_JPRB ,2.47330_JPRB ,2.02428_JPRB ,1.52509_JPRB , & & 1.03037_JPRB ,0.112553_JPRB ,9.35352E-02_JPRB,7.39675E-02_JPRB, & - & 5.43951E-02_JPRB,3.45669E-02_JPRB,1.30292E-02_JPRB,1.84198E-03_JPRB /) + & 5.43951E-02_JPRB,3.45669E-02_JPRB,1.30292E-02_JPRB,1.84198E-03_JPRB /) SFLUXREF(:, 5) = (/ & & 3.73809_JPRB ,3.60996_JPRB ,3.43602_JPRB ,3.20364_JPRB , & & 2.87005_JPRB ,2.47343_JPRB ,2.02353_JPRB ,1.52617_JPRB , & & 1.03138_JPRB ,0.111172_JPRB ,9.29885E-02_JPRB,7.35034E-02_JPRB, & - & 5.42427E-02_JPRB,3.45732E-02_JPRB,1.30169E-02_JPRB,1.84550E-03_JPRB /) + & 5.42427E-02_JPRB,3.45732E-02_JPRB,1.30169E-02_JPRB,1.84550E-03_JPRB /) SFLUXREF(:, 6) = (/ & & 3.73872_JPRB ,3.62054_JPRB ,3.42934_JPRB ,3.20110_JPRB , & & 2.86886_JPRB ,2.47379_JPRB ,2.02237_JPRB ,1.52754_JPRB , & & 1.03228_JPRB ,0.111597_JPRB ,9.12252E-02_JPRB,7.33115E-02_JPRB, & - & 5.35600E-02_JPRB,3.45187E-02_JPRB,1.30184E-02_JPRB,1.84551E-03_JPRB /) + & 5.35600E-02_JPRB,3.45187E-02_JPRB,1.30184E-02_JPRB,1.84551E-03_JPRB /) SFLUXREF(:, 7) = (/ & & 3.73969_JPRB ,3.65461_JPRB ,3.40646_JPRB ,3.19082_JPRB , & & 2.86919_JPRB ,2.47289_JPRB ,2.02312_JPRB ,1.52629_JPRB , & & 1.03329_JPRB ,0.111611_JPRB ,9.16275E-02_JPRB,7.14731E-02_JPRB, & - & 5.31771E-02_JPRB,3.44980E-02_JPRB,1.30190E-02_JPRB,1.84551E-03_JPRB /) + & 5.31771E-02_JPRB,3.44980E-02_JPRB,1.30190E-02_JPRB,1.84551E-03_JPRB /) SFLUXREF(:, 8) = (/ & & 3.73995_JPRB ,3.65348_JPRB ,3.43707_JPRB ,3.16351_JPRB , & & 2.87003_JPRB ,2.47392_JPRB ,2.02114_JPRB ,1.52548_JPRB , & & 1.03306_JPRB ,0.111088_JPRB ,9.12422E-02_JPRB,7.11146E-02_JPRB, & - & 5.31333E-02_JPRB,3.45302E-02_JPRB,1.30209E-02_JPRB,1.84554E-03_JPRB /) + & 5.31333E-02_JPRB,3.45302E-02_JPRB,1.30209E-02_JPRB,1.84554E-03_JPRB /) SFLUXREF(:, 9) = (/ & & 3.73788_JPRB ,3.65004_JPRB ,3.46938_JPRB ,3.15236_JPRB , & & 2.86381_JPRB ,2.47393_JPRB ,2.01715_JPRB ,1.52134_JPRB , & & 1.03163_JPRB ,0.111259_JPRB ,9.12948E-02_JPRB,7.09999E-02_JPRB, & - & 5.31792E-02_JPRB,3.44955E-02_JPRB,1.30189E-02_JPRB,1.84551E-03_JPRB /) + & 5.31792E-02_JPRB,3.44955E-02_JPRB,1.30189E-02_JPRB,1.84551E-03_JPRB /) ! Rayleigh extinction coefficient at v = 8000 cm-1. RAYL = 1.54E-08_JPRB @@ -95,12 +104,12 @@ SUBROUTINE SRTM_KGB22 ! ------------------------------------------------------------------ -! The array KA contains absorption coefs at the 16 chosen g-values +! The array KA contains absorption coefs at the 16 chosen g-values ! for a range of pressure levels> ~100mb, temperatures, and binary -! species parameters (see taumol.f for definition). The first -! index in the array, JS, runs from 1 to 9, and corresponds to -! different values of the binary species parameter. For instance, -! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, +! species parameters (see taumol.f for definition). The first +! index in the array, JS, runs from 1 to 9, and corresponds to +! different values of the binary species parameter. For instance, +! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, ! JS = 3 corresponds to the parameter value 2/8, etc. The second index ! in the array, JT, which runs from 1 to 5, corresponds to different ! temperatures. More specifically, JT = 3 means that the data are for @@ -113,13 +122,13 @@ SUBROUTINE SRTM_KGB22 ! ----------------------------------------------------------------- ! ----------------------------------------------------------------- -! The array KB contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure +! The array KB contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure ! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. ! The second index, JP, runs from 13 to 59 and refers to the JPth ! reference pressure level (see taumol.f for the value of these ! pressure levels in mb). The third index, IG, goes from 1 to 16, @@ -153,52 +162,52 @@ SUBROUTINE SRTM_KGB22 SELFREF(:, 1) = (/ & & 0.538526E-04_JPRB, 0.464603E-04_JPRB, 0.400828E-04_JPRB, 0.345807E-04_JPRB, 0.298339E-04_JPRB, & - & 0.257386E-04_JPRB, 0.222055E-04_JPRB, 0.191574E-04_JPRB, 0.165277E-04_JPRB, 0.142590E-04_JPRB /) + & 0.257386E-04_JPRB, 0.222055E-04_JPRB, 0.191574E-04_JPRB, 0.165277E-04_JPRB, 0.142590E-04_JPRB /) SELFREF(:, 2) = (/ & & 0.162409E-03_JPRB, 0.128347E-03_JPRB, 0.101430E-03_JPRB, 0.801571E-04_JPRB, 0.633460E-04_JPRB, & - & 0.500607E-04_JPRB, 0.395616E-04_JPRB, 0.312645E-04_JPRB, 0.247075E-04_JPRB, 0.195257E-04_JPRB /) + & 0.500607E-04_JPRB, 0.395616E-04_JPRB, 0.312645E-04_JPRB, 0.247075E-04_JPRB, 0.195257E-04_JPRB /) SELFREF(:, 3) = (/ & & 0.262882E-03_JPRB, 0.212793E-03_JPRB, 0.172247E-03_JPRB, 0.139427E-03_JPRB, 0.112860E-03_JPRB, & - & 0.913557E-04_JPRB, 0.739487E-04_JPRB, 0.598584E-04_JPRB, 0.484529E-04_JPRB, 0.392206E-04_JPRB /) + & 0.913557E-04_JPRB, 0.739487E-04_JPRB, 0.598584E-04_JPRB, 0.484529E-04_JPRB, 0.392206E-04_JPRB /) SELFREF(:, 4) = (/ & & 0.242873E-03_JPRB, 0.204225E-03_JPRB, 0.171726E-03_JPRB, 0.144399E-03_JPRB, 0.121421E-03_JPRB, & - & 0.102099E-03_JPRB, 0.858516E-04_JPRB, 0.721899E-04_JPRB, 0.607022E-04_JPRB, 0.510426E-04_JPRB /) + & 0.102099E-03_JPRB, 0.858516E-04_JPRB, 0.721899E-04_JPRB, 0.607022E-04_JPRB, 0.510426E-04_JPRB /) SELFREF(:, 5) = (/ & & 0.235614E-03_JPRB, 0.207814E-03_JPRB, 0.183293E-03_JPRB, 0.161666E-03_JPRB, 0.142591E-03_JPRB, & - & 0.125766E-03_JPRB, 0.110927E-03_JPRB, 0.978381E-04_JPRB, 0.862939E-04_JPRB, 0.761119E-04_JPRB /) + & 0.125766E-03_JPRB, 0.110927E-03_JPRB, 0.978381E-04_JPRB, 0.862939E-04_JPRB, 0.761119E-04_JPRB /) SELFREF(:, 6) = (/ & & 0.205508E-03_JPRB, 0.190174E-03_JPRB, 0.175985E-03_JPRB, 0.162854E-03_JPRB, 0.150702E-03_JPRB, & - & 0.139458E-03_JPRB, 0.129052E-03_JPRB, 0.119423E-03_JPRB, 0.110513E-03_JPRB, 0.102267E-03_JPRB /) + & 0.139458E-03_JPRB, 0.129052E-03_JPRB, 0.119423E-03_JPRB, 0.110513E-03_JPRB, 0.102267E-03_JPRB /) SELFREF(:, 7) = (/ & & 0.185027E-03_JPRB, 0.175148E-03_JPRB, 0.165796E-03_JPRB, 0.156944E-03_JPRB, 0.148565E-03_JPRB, & - & 0.140633E-03_JPRB, 0.133124E-03_JPRB, 0.126016E-03_JPRB, 0.119288E-03_JPRB, 0.112919E-03_JPRB /) + & 0.140633E-03_JPRB, 0.133124E-03_JPRB, 0.126016E-03_JPRB, 0.119288E-03_JPRB, 0.112919E-03_JPRB /) SELFREF(:, 8) = (/ & & 0.192634E-03_JPRB, 0.180192E-03_JPRB, 0.168554E-03_JPRB, 0.157668E-03_JPRB, 0.147484E-03_JPRB, & - & 0.137959E-03_JPRB, 0.129048E-03_JPRB, 0.120713E-03_JPRB, 0.112917E-03_JPRB, 0.105624E-03_JPRB /) + & 0.137959E-03_JPRB, 0.129048E-03_JPRB, 0.120713E-03_JPRB, 0.112917E-03_JPRB, 0.105624E-03_JPRB /) SELFREF(:, 9) = (/ & & 0.161632E-03_JPRB, 0.155919E-03_JPRB, 0.150408E-03_JPRB, 0.145092E-03_JPRB, 0.139963E-03_JPRB, & - & 0.135016E-03_JPRB, 0.130244E-03_JPRB, 0.125640E-03_JPRB, 0.121199E-03_JPRB, 0.116915E-03_JPRB /) + & 0.135016E-03_JPRB, 0.130244E-03_JPRB, 0.125640E-03_JPRB, 0.121199E-03_JPRB, 0.116915E-03_JPRB /) SELFREF(:,10) = (/ & & 0.120880E-03_JPRB, 0.125265E-03_JPRB, 0.129810E-03_JPRB, 0.134520E-03_JPRB, 0.139400E-03_JPRB, & - & 0.144458E-03_JPRB, 0.149699E-03_JPRB, 0.155130E-03_JPRB, 0.160758E-03_JPRB, 0.166591E-03_JPRB /) + & 0.144458E-03_JPRB, 0.149699E-03_JPRB, 0.155130E-03_JPRB, 0.160758E-03_JPRB, 0.166591E-03_JPRB /) SELFREF(:,11) = (/ & & 0.104705E-03_JPRB, 0.111761E-03_JPRB, 0.119291E-03_JPRB, 0.127330E-03_JPRB, 0.135910E-03_JPRB, & - & 0.145068E-03_JPRB, 0.154843E-03_JPRB, 0.165277E-03_JPRB, 0.176414E-03_JPRB, 0.188302E-03_JPRB /) + & 0.145068E-03_JPRB, 0.154843E-03_JPRB, 0.165277E-03_JPRB, 0.176414E-03_JPRB, 0.188302E-03_JPRB /) SELFREF(:,12) = (/ & & 0.846335E-04_JPRB, 0.951236E-04_JPRB, 0.106914E-03_JPRB, 0.120166E-03_JPRB, 0.135060E-03_JPRB, & - & 0.151800E-03_JPRB, 0.170616E-03_JPRB, 0.191763E-03_JPRB, 0.215532E-03_JPRB, 0.242246E-03_JPRB /) + & 0.151800E-03_JPRB, 0.170616E-03_JPRB, 0.191763E-03_JPRB, 0.215532E-03_JPRB, 0.242246E-03_JPRB /) SELFREF(:,13) = (/ & & 0.669754E-04_JPRB, 0.781902E-04_JPRB, 0.912829E-04_JPRB, 0.106568E-03_JPRB, 0.124413E-03_JPRB, & - & 0.145245E-03_JPRB, 0.169566E-03_JPRB, 0.197959E-03_JPRB, 0.231107E-03_JPRB, 0.269805E-03_JPRB /) + & 0.145245E-03_JPRB, 0.169566E-03_JPRB, 0.197959E-03_JPRB, 0.231107E-03_JPRB, 0.269805E-03_JPRB /) SELFREF(:,14) = (/ & & 0.597091E-04_JPRB, 0.722265E-04_JPRB, 0.873679E-04_JPRB, 0.105684E-03_JPRB, 0.127839E-03_JPRB, & - & 0.154639E-03_JPRB, 0.187057E-03_JPRB, 0.226272E-03_JPRB, 0.273707E-03_JPRB, 0.331087E-03_JPRB /) + & 0.154639E-03_JPRB, 0.187057E-03_JPRB, 0.226272E-03_JPRB, 0.273707E-03_JPRB, 0.331087E-03_JPRB /) SELFREF(:,15) = (/ & & 0.640410E-04_JPRB, 0.771879E-04_JPRB, 0.930338E-04_JPRB, 0.112133E-03_JPRB, 0.135152E-03_JPRB, & - & 0.162897E-03_JPRB, 0.196338E-03_JPRB, 0.236644E-03_JPRB, 0.285225E-03_JPRB, 0.343778E-03_JPRB /) + & 0.162897E-03_JPRB, 0.196338E-03_JPRB, 0.236644E-03_JPRB, 0.285225E-03_JPRB, 0.343778E-03_JPRB /) SELFREF(:,16) = (/ & & 0.666420E-04_JPRB, 0.801056E-04_JPRB, 0.962892E-04_JPRB, 0.115742E-03_JPRB, 0.139126E-03_JPRB, & - & 0.167233E-03_JPRB, 0.201019E-03_JPRB, 0.241630E-03_JPRB, 0.290446E-03_JPRB, 0.349125E-03_JPRB /) + & 0.167233E-03_JPRB, 0.201019E-03_JPRB, 0.241630E-03_JPRB, 0.290446E-03_JPRB, 0.349125E-03_JPRB /) IF (LHOOK) CALL DR_HOOK('SRTM_KGB22',1,ZHOOK_HANDLE) RETURN diff --git a/ifsrrtm/srtm_kgb23.F90 b/ifsrrtm/srtm_kgb23.F90 index 396a9cd5..e8706d0d 100644 --- a/ifsrrtm/srtm_kgb23.F90 +++ b/ifsrrtm/srtm_kgb23.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_KGB23 ! Originally by J.Delamere, Atmospheric & Environmental Research. @@ -11,8 +20,8 @@ SUBROUTINE SRTM_KGB23 USE PARKIND1 , ONLY : JPRB USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN_ECRAD, ONLY : NULRAD -USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC +USE YOMLUN_ECRAD,ONLY : NULRAD +USE YOMMP0_IFSAUX,ONLY : NPROC, MYPROC USE MPL_MODULE, ONLY : MPL_BROADCAST USE YOMTAG , ONLY : MTAGRAD USE YOESRTA23 , ONLY : KA, SELFREF, FORREF, SFLUXREF, RAYL, GIVFAC, LAYREFFR ,& @@ -41,14 +50,14 @@ SUBROUTINE SRTM_KGB23 & 53.2101_JPRB , 51.4143_JPRB, 49.3348_JPRB, 45.4612_JPRB , & & 40.8294_JPRB , 35.1801_JPRB, 28.6947_JPRB, 21.5751_JPRB , & & 14.6388_JPRB , 1.59111_JPRB, 1.31860_JPRB, 1.04018_JPRB , & - & 0.762140_JPRB,0.484214_JPRB,0.182275_JPRB, 2.54948E-02_JPRB /) + & 0.762140_JPRB,0.484214_JPRB,0.182275_JPRB, 2.54948E-02_JPRB /) -! Rayleigh extinction coefficient at all v +! Rayleigh extinction coefficient at all v RAYL = (/ & & 5.94837E-08_JPRB,5.70593E-08_JPRB,6.27845E-08_JPRB,5.56602E-08_JPRB, & & 5.25571E-08_JPRB,4.73388E-08_JPRB,4.17466E-08_JPRB,3.98097E-08_JPRB, & & 4.00786E-08_JPRB,3.67478E-08_JPRB,3.45186E-08_JPRB,3.46156E-08_JPRB, & - & 3.32155E-08_JPRB,3.23642E-08_JPRB,2.72590E-08_JPRB,2.96813E-08_JPRB /) + & 3.32155E-08_JPRB,3.23642E-08_JPRB,2.72590E-08_JPRB,2.96813E-08_JPRB /) ! Average Giver et al. correction factor for this band. GIVFAC = 1.029_JPRB @@ -57,12 +66,12 @@ SUBROUTINE SRTM_KGB23 ! ------------------------------------------------------------------ -! The array KA contains absorption coefs at the 16 chosen g-values +! The array KA contains absorption coefs at the 16 chosen g-values ! for a range of pressure levels> ~100mb, temperatures, and binary -! species parameters (see taumol.f for definition). The first -! index in the array, JS, runs from 1 to 9, and corresponds to -! different values of the binary species parameter. For instance, -! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, +! species parameters (see taumol.f for definition). The first +! index in the array, JS, runs from 1 to 9, and corresponds to +! different values of the binary species parameter. For instance, +! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, ! JS = 3 corresponds to the parameter value 2/8, etc. The second index ! in the array, JT, which runs from 1 to 5, corresponds to different ! temperatures. More specifically, JT = 3 means that the data are for @@ -100,53 +109,53 @@ SUBROUTINE SRTM_KGB23 SELFREF(:, 1) = (/ & & 0.100945E-04_JPRB, 0.801113E-05_JPRB, 0.635771E-05_JPRB, 0.504554E-05_JPRB, 0.400419E-05_JPRB, & - & 0.317777E-05_JPRB, 0.252191E-05_JPRB, 0.200141E-05_JPRB, 0.158834E-05_JPRB, 0.126052E-05_JPRB /) + & 0.317777E-05_JPRB, 0.252191E-05_JPRB, 0.200141E-05_JPRB, 0.158834E-05_JPRB, 0.126052E-05_JPRB /) SELFREF(:, 2) = (/ & & 0.107573E-04_JPRB, 0.999809E-05_JPRB, 0.929245E-05_JPRB, 0.863661E-05_JPRB, 0.802706E-05_JPRB, & - & 0.746053E-05_JPRB, 0.693399E-05_JPRB, 0.644460E-05_JPRB, 0.598976E-05_JPRB, 0.556702E-05_JPRB /) + & 0.746053E-05_JPRB, 0.693399E-05_JPRB, 0.644460E-05_JPRB, 0.598976E-05_JPRB, 0.556702E-05_JPRB /) SELFREF(:, 3) = (/ & & 0.350389E-04_JPRB, 0.319234E-04_JPRB, 0.290850E-04_JPRB, 0.264989E-04_JPRB, 0.241428E-04_JPRB, & - & 0.219962E-04_JPRB, 0.200404E-04_JPRB, 0.182586E-04_JPRB, 0.166351E-04_JPRB, 0.151560E-04_JPRB /) + & 0.219962E-04_JPRB, 0.200404E-04_JPRB, 0.182586E-04_JPRB, 0.166351E-04_JPRB, 0.151560E-04_JPRB /) SELFREF(:, 4) = (/ & & 0.122993E-03_JPRB, 0.110885E-03_JPRB, 0.999691E-04_JPRB, 0.901277E-04_JPRB, 0.812551E-04_JPRB, & - & 0.732559E-04_JPRB, 0.660443E-04_JPRB, 0.595426E-04_JPRB, 0.536809E-04_JPRB, 0.483963E-04_JPRB /) + & 0.732559E-04_JPRB, 0.660443E-04_JPRB, 0.595426E-04_JPRB, 0.536809E-04_JPRB, 0.483963E-04_JPRB /) SELFREF(:, 5) = (/ & & 0.206434E-03_JPRB, 0.187435E-03_JPRB, 0.170185E-03_JPRB, 0.154522E-03_JPRB, 0.140301E-03_JPRB, & - & 0.127388E-03_JPRB, 0.115664E-03_JPRB, 0.105019E-03_JPRB, 0.953540E-04_JPRB, 0.865783E-04_JPRB /) + & 0.127388E-03_JPRB, 0.115664E-03_JPRB, 0.105019E-03_JPRB, 0.953540E-04_JPRB, 0.865783E-04_JPRB /) SELFREF(:, 6) = (/ & & 0.590645E-03_JPRB, 0.533109E-03_JPRB, 0.481177E-03_JPRB, 0.434305E-03_JPRB, 0.391998E-03_JPRB, & - & 0.353812E-03_JPRB, 0.319346E-03_JPRB, 0.288238E-03_JPRB, 0.260160E-03_JPRB, 0.234817E-03_JPRB /) + & 0.353812E-03_JPRB, 0.319346E-03_JPRB, 0.288238E-03_JPRB, 0.260160E-03_JPRB, 0.234817E-03_JPRB /) SELFREF(:, 7) = (/ & & 0.163029E-02_JPRB, 0.148773E-02_JPRB, 0.135763E-02_JPRB, 0.123891E-02_JPRB, 0.113057E-02_JPRB, & - & 0.103170E-02_JPRB, 0.941483E-03_JPRB, 0.859153E-03_JPRB, 0.784023E-03_JPRB, 0.715462E-03_JPRB /) + & 0.103170E-02_JPRB, 0.941483E-03_JPRB, 0.859153E-03_JPRB, 0.784023E-03_JPRB, 0.715462E-03_JPRB /) SELFREF(:, 8) = (/ & & 0.204528E-02_JPRB, 0.189258E-02_JPRB, 0.175128E-02_JPRB, 0.162053E-02_JPRB, 0.149954E-02_JPRB, & - & 0.138758E-02_JPRB, 0.128398E-02_JPRB, 0.118812E-02_JPRB, 0.109941E-02_JPRB, 0.101733E-02_JPRB /) + & 0.138758E-02_JPRB, 0.128398E-02_JPRB, 0.118812E-02_JPRB, 0.109941E-02_JPRB, 0.101733E-02_JPRB /) SELFREF(:, 9) = (/ & & 0.210589E-02_JPRB, 0.197078E-02_JPRB, 0.184434E-02_JPRB, 0.172601E-02_JPRB, 0.161528E-02_JPRB, & - & 0.151164E-02_JPRB, 0.141466E-02_JPRB, 0.132390E-02_JPRB, 0.123896E-02_JPRB, 0.115947E-02_JPRB /) + & 0.151164E-02_JPRB, 0.141466E-02_JPRB, 0.132390E-02_JPRB, 0.123896E-02_JPRB, 0.115947E-02_JPRB /) SELFREF(:,10) = (/ & & 0.245098E-02_JPRB, 0.233745E-02_JPRB, 0.222918E-02_JPRB, 0.212592E-02_JPRB, 0.202745E-02_JPRB, & - & 0.193353E-02_JPRB, 0.184397E-02_JPRB, 0.175856E-02_JPRB, 0.167710E-02_JPRB, 0.159941E-02_JPRB /) + & 0.193353E-02_JPRB, 0.184397E-02_JPRB, 0.175856E-02_JPRB, 0.167710E-02_JPRB, 0.159941E-02_JPRB /) SELFREF(:,11) = (/ & & 0.267460E-02_JPRB, 0.253325E-02_JPRB, 0.239936E-02_JPRB, 0.227255E-02_JPRB, 0.215244E-02_JPRB, & - & 0.203868E-02_JPRB, 0.193093E-02_JPRB, 0.182888E-02_JPRB, 0.173222E-02_JPRB, 0.164067E-02_JPRB /) + & 0.203868E-02_JPRB, 0.193093E-02_JPRB, 0.182888E-02_JPRB, 0.173222E-02_JPRB, 0.164067E-02_JPRB /) SELFREF(:,12) = (/ & & 0.304510E-02_JPRB, 0.283919E-02_JPRB, 0.264720E-02_JPRB, 0.246820E-02_JPRB, 0.230130E-02_JPRB, & - & 0.214568E-02_JPRB, 0.200059E-02_JPRB, 0.186531E-02_JPRB, 0.173918E-02_JPRB, 0.162157E-02_JPRB /) + & 0.214568E-02_JPRB, 0.200059E-02_JPRB, 0.186531E-02_JPRB, 0.173918E-02_JPRB, 0.162157E-02_JPRB /) SELFREF(:,13) = (/ & & 0.338445E-02_JPRB, 0.314719E-02_JPRB, 0.292655E-02_JPRB, 0.272139E-02_JPRB, 0.253060E-02_JPRB, & - & 0.235319E-02_JPRB, 0.218822E-02_JPRB, 0.203482E-02_JPRB, 0.189217E-02_JPRB, 0.175952E-02_JPRB /) + & 0.235319E-02_JPRB, 0.218822E-02_JPRB, 0.203482E-02_JPRB, 0.189217E-02_JPRB, 0.175952E-02_JPRB /) SELFREF(:,14) = (/ & & 0.388649E-02_JPRB, 0.357018E-02_JPRB, 0.327961E-02_JPRB, 0.301269E-02_JPRB, 0.276750E-02_JPRB, & - & 0.254226E-02_JPRB, 0.233535E-02_JPRB, 0.214528E-02_JPRB, 0.197068E-02_JPRB, 0.181029E-02_JPRB /) + & 0.254226E-02_JPRB, 0.233535E-02_JPRB, 0.214528E-02_JPRB, 0.197068E-02_JPRB, 0.181029E-02_JPRB /) SELFREF(:,15) = (/ & & 0.412547E-02_JPRB, 0.387413E-02_JPRB, 0.363810E-02_JPRB, 0.341646E-02_JPRB, 0.320831E-02_JPRB, & - & 0.301285E-02_JPRB, 0.282930E-02_JPRB, 0.265693E-02_JPRB, 0.249506E-02_JPRB, 0.234305E-02_JPRB /) + & 0.301285E-02_JPRB, 0.282930E-02_JPRB, 0.265693E-02_JPRB, 0.249506E-02_JPRB, 0.234305E-02_JPRB /) SELFREF(:,16) = (/ & & 0.534327E-02_JPRB, 0.482967E-02_JPRB, 0.436544E-02_JPRB, 0.394583E-02_JPRB, 0.356655E-02_JPRB, & - & 0.322373E-02_JPRB, 0.291387E-02_JPRB, 0.263378E-02_JPRB, 0.238062E-02_JPRB, 0.215179E-02_JPRB /) - + & 0.322373E-02_JPRB, 0.291387E-02_JPRB, 0.263378E-02_JPRB, 0.238062E-02_JPRB, 0.215179E-02_JPRB /) + ! ----------------------------------------------------------------- IF (LHOOK) CALL DR_HOOK('SRTM_KGB23',1,ZHOOK_HANDLE) RETURN diff --git a/ifsrrtm/srtm_kgb24.F90 b/ifsrrtm/srtm_kgb24.F90 index d4d789f5..3fc089bc 100644 --- a/ifsrrtm/srtm_kgb24.F90 +++ b/ifsrrtm/srtm_kgb24.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_KGB24 ! Originally by J.Delamere, Atmospheric & Environmental Research. @@ -12,8 +21,8 @@ SUBROUTINE SRTM_KGB24 USE PARKIND1 , ONLY : JPRB USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN_ECRAD, ONLY : NULRAD -USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC +USE YOMLUN_ECRAD,ONLY : NULRAD +USE YOMMP0_IFSAUX,ONLY : NPROC, MYPROC USE MPL_MODULE, ONLY : MPL_BROADCAST USE YOMTAG , ONLY : MTAGRAD USE YOESRTA24 , ONLY : KA, KB, SELFREF, FORREF, SFLUXREF, RAYLA, RAYLB, & @@ -44,112 +53,112 @@ SUBROUTINE SRTM_KGB24 & 34.3610_JPRB , 33.1240_JPRB, 31.3948_JPRB, 28.7248_JPRB, & & 24.7884_JPRB , 21.4892_JPRB, 17.3972_JPRB, 13.7928_JPRB, & & 9.54462_JPRB , 1.05002_JPRB,0.867332_JPRB,0.685753_JPRB, & - & 0.504718_JPRB,0.323112_JPRB,0.122183_JPRB, 1.70288E-02_JPRB /) + & 0.504718_JPRB,0.323112_JPRB,0.122183_JPRB, 1.70288E-02_JPRB /) SFLUXREF(:,2) = (/ & & 34.2367_JPRB , 32.4327_JPRB, 30.0863_JPRB, 28.2085_JPRB, & & 25.6533_JPRB , 22.3412_JPRB, 18.3112_JPRB, 13.8521_JPRB, & & 9.51035_JPRB , 1.04138_JPRB,0.863493_JPRB,0.682790_JPRB, & - & 0.504721_JPRB,0.323102_JPRB,0.122193_JPRB, 1.70288E-02_JPRB /) + & 0.504721_JPRB,0.323102_JPRB,0.122193_JPRB, 1.70288E-02_JPRB /) SFLUXREF(:,3) = (/ & & 34.1883_JPRB , 32.2479_JPRB, 30.2650_JPRB, 28.2914_JPRB, & & 25.6626_JPRB , 22.3163_JPRB, 18.3327_JPRB, 13.8508_JPRB, & & 9.49190_JPRB , 1.03672_JPRB,0.858272_JPRB,0.681485_JPRB, & - & 0.501363_JPRB,0.323110_JPRB,0.122183_JPRB, 1.70288E-02_JPRB /) + & 0.501363_JPRB,0.323110_JPRB,0.122183_JPRB, 1.70288E-02_JPRB /) SFLUXREF(:,4) = (/ & & 34.1365_JPRB , 32.2316_JPRB, 30.3325_JPRB, 28.3305_JPRB, & & 25.6420_JPRB , 22.3223_JPRB, 18.3411_JPRB, 13.8471_JPRB, & & 9.47492_JPRB , 1.03376_JPRB,0.855380_JPRB,0.679085_JPRB, & - & 0.497998_JPRB,0.323053_JPRB,0.122183_JPRB, 1.70288E-02_JPRB /) + & 0.497998_JPRB,0.323053_JPRB,0.122183_JPRB, 1.70288E-02_JPRB /) SFLUXREF(:,5) = (/ & & 34.0460_JPRB , 32.2795_JPRB, 30.4147_JPRB, 28.3123_JPRB, & & 25.6438_JPRB , 22.3238_JPRB, 18.3441_JPRB, 13.8528_JPRB, & & 9.45222_JPRB , 1.03058_JPRB,0.854037_JPRB,0.675554_JPRB, & - & 0.498344_JPRB,0.320072_JPRB,0.122193_JPRB, 1.70288E-02_JPRB /) + & 0.498344_JPRB,0.320072_JPRB,0.122193_JPRB, 1.70288E-02_JPRB /) SFLUXREF(:,6) = (/ & & 33.9909_JPRB , 32.3127_JPRB, 30.4854_JPRB, 28.3005_JPRB, & & 25.6310_JPRB , 22.3294_JPRB, 18.3459_JPRB, 13.8488_JPRB, & & 9.43336_JPRB , 1.02901_JPRB,0.852728_JPRB,0.672322_JPRB, & - & 0.498056_JPRB,0.317753_JPRB,0.122183_JPRB, 1.70288E-02_JPRB /) + & 0.498056_JPRB,0.317753_JPRB,0.122183_JPRB, 1.70288E-02_JPRB /) SFLUXREF(:,7) = (/ & & 33.9225_JPRB , 32.4097_JPRB, 30.5125_JPRB, 28.2810_JPRB, & & 25.6387_JPRB , 22.3080_JPRB, 18.3715_JPRB, 13.8248_JPRB, & & 9.41834_JPRB , 1.02735_JPRB,0.850807_JPRB,0.671379_JPRB, & - & 0.496975_JPRB,0.317158_JPRB,0.119297_JPRB, 1.70207E-02_JPRB /) + & 0.496975_JPRB,0.317158_JPRB,0.119297_JPRB, 1.70207E-02_JPRB /) SFLUXREF(:,8) = (/ & & 33.8940_JPRB , 32.4951_JPRB, 30.5494_JPRB, 28.2788_JPRB, & & 25.5975_JPRB , 22.3225_JPRB, 18.3358_JPRB, 13.8199_JPRB, & & 9.40283_JPRB , 1.02751_JPRB,0.850729_JPRB,0.670152_JPRB, & - & 0.494294_JPRB,0.315829_JPRB,0.116195_JPRB, 1.64138E-02_JPRB /) + & 0.494294_JPRB,0.315829_JPRB,0.116195_JPRB, 1.64138E-02_JPRB /) SFLUXREF(:,9) = (/ & & 34.6501_JPRB , 32.6690_JPRB, 30.2872_JPRB, 28.0955_JPRB, & & 25.4662_JPRB , 22.1446_JPRB, 18.2754_JPRB, 13.7573_JPRB, & & 9.36645_JPRB , 1.02356_JPRB,0.847154_JPRB,0.668519_JPRB, & - & 0.489186_JPRB,0.313790_JPRB,0.117074_JPRB, 1.60943E-02_JPRB /) + & 0.489186_JPRB,0.313790_JPRB,0.117074_JPRB, 1.60943E-02_JPRB /) ! Rayleigh extinction coefficient at all v RAYLA(:,1) = (/ & & 1.28405E-07_JPRB,1.45501E-07_JPRB,1.67272E-07_JPRB,1.94856E-07_JPRB, & & 2.15248E-07_JPRB,2.34920E-07_JPRB,2.48558E-07_JPRB,1.80004E-07_JPRB, & & 1.46504E-07_JPRB,1.31355E-07_JPRB,1.33562E-07_JPRB,1.35618E-07_JPRB, & - & 1.22412E-07_JPRB,1.19842E-07_JPRB,1.19924E-07_JPRB,1.20264E-07_JPRB /) + & 1.22412E-07_JPRB,1.19842E-07_JPRB,1.19924E-07_JPRB,1.20264E-07_JPRB /) RAYLA(:,2) = (/ & & 1.41622E-07_JPRB,1.93436E-07_JPRB,2.25057E-07_JPRB,2.01025E-07_JPRB, & & 1.85138E-07_JPRB,1.72672E-07_JPRB,1.64771E-07_JPRB,1.59312E-07_JPRB, & & 1.44961E-07_JPRB,1.37448E-07_JPRB,1.37506E-07_JPRB,1.38081E-07_JPRB, & - & 1.22432E-07_JPRB,1.19844E-07_JPRB,1.19921E-07_JPRB,1.20287E-07_JPRB /) + & 1.22432E-07_JPRB,1.19844E-07_JPRB,1.19921E-07_JPRB,1.20287E-07_JPRB /) RAYLA(:,3) = (/ & & 1.45382E-07_JPRB,1.97020E-07_JPRB,2.22781E-07_JPRB,1.96062E-07_JPRB, & & 1.83495E-07_JPRB,1.72495E-07_JPRB,1.64910E-07_JPRB,1.58797E-07_JPRB, & & 1.46208E-07_JPRB,1.42274E-07_JPRB,1.40445E-07_JPRB,1.39496E-07_JPRB, & - & 1.26940E-07_JPRB,1.19844E-07_JPRB,1.19921E-07_JPRB,1.20287E-07_JPRB /) + & 1.26940E-07_JPRB,1.19844E-07_JPRB,1.19921E-07_JPRB,1.20287E-07_JPRB /) RAYLA(:,4) = (/ & & 1.48247E-07_JPRB,1.99958E-07_JPRB,2.18048E-07_JPRB,1.93896E-07_JPRB, & & 1.83125E-07_JPRB,1.73244E-07_JPRB,1.64320E-07_JPRB,1.58298E-07_JPRB, & & 1.48428E-07_JPRB,1.44769E-07_JPRB,1.43704E-07_JPRB,1.38498E-07_JPRB, & - & 1.31732E-07_JPRB,1.22299E-07_JPRB,1.19921E-07_JPRB,1.20287E-07_JPRB /) + & 1.31732E-07_JPRB,1.22299E-07_JPRB,1.19921E-07_JPRB,1.20287E-07_JPRB /) RAYLA(:,5) = (/ & & 1.51343E-07_JPRB,1.99621E-07_JPRB,2.14563E-07_JPRB,1.93824E-07_JPRB, & & 1.82992E-07_JPRB,1.73143E-07_JPRB,1.64587E-07_JPRB,1.57355E-07_JPRB, & & 1.51198E-07_JPRB,1.46373E-07_JPRB,1.45438E-07_JPRB,1.38095E-07_JPRB, & - & 1.35026E-07_JPRB,1.27504E-07_JPRB,1.19921E-07_JPRB,1.20287E-07_JPRB /) + & 1.35026E-07_JPRB,1.27504E-07_JPRB,1.19921E-07_JPRB,1.20287E-07_JPRB /) RAYLA(:,6) = (/ & & 1.54462E-07_JPRB,1.97610E-07_JPRB,2.11992E-07_JPRB,1.93831E-07_JPRB, & & 1.83900E-07_JPRB,1.73125E-07_JPRB,1.64093E-07_JPRB,1.57651E-07_JPRB, & & 1.53158E-07_JPRB,1.46843E-07_JPRB,1.44733E-07_JPRB,1.40611E-07_JPRB, & - & 1.37320E-07_JPRB,1.33932E-07_JPRB,1.20423E-07_JPRB,1.20287E-07_JPRB /) + & 1.37320E-07_JPRB,1.33932E-07_JPRB,1.20423E-07_JPRB,1.20287E-07_JPRB /) RAYLA(:,7) = (/ & & 1.59068E-07_JPRB,1.92757E-07_JPRB,2.09865E-07_JPRB,1.95132E-07_JPRB, & & 1.83641E-07_JPRB,1.73778E-07_JPRB,1.63215E-07_JPRB,1.59462E-07_JPRB, & & 1.54331E-07_JPRB,1.46177E-07_JPRB,1.45819E-07_JPRB,1.43177E-07_JPRB, & - & 1.39797E-07_JPRB,1.36780E-07_JPRB,1.33385E-07_JPRB,1.20287E-07_JPRB /) + & 1.39797E-07_JPRB,1.36780E-07_JPRB,1.33385E-07_JPRB,1.20287E-07_JPRB /) RAYLA(:,8) = (/ & & 1.62066E-07_JPRB,1.87529E-07_JPRB,2.07191E-07_JPRB,1.97788E-07_JPRB, & & 1.84920E-07_JPRB,1.72951E-07_JPRB,1.65450E-07_JPRB,1.60344E-07_JPRB, & & 1.54403E-07_JPRB,1.47679E-07_JPRB,1.47287E-07_JPRB,1.44951E-07_JPRB, & - & 1.42517E-07_JPRB,1.41107E-07_JPRB,1.48688E-07_JPRB,1.51127E-07_JPRB /) + & 1.42517E-07_JPRB,1.41107E-07_JPRB,1.48688E-07_JPRB,1.51127E-07_JPRB /) RAYLA(:,9) = (/ & & 1.19177E-07_JPRB,1.86522E-07_JPRB,2.20324E-07_JPRB,2.13543E-07_JPRB, & & 1.92198E-07_JPRB,1.81641E-07_JPRB,1.70092E-07_JPRB,1.65072E-07_JPRB, & & 1.59804E-07_JPRB,1.56745E-07_JPRB,1.51235E-07_JPRB,1.51400E-07_JPRB, & - & 1.49635E-07_JPRB,1.48056E-07_JPRB,1.49046E-07_JPRB,1.51010E-07_JPRB /) + & 1.49635E-07_JPRB,1.48056E-07_JPRB,1.49046E-07_JPRB,1.51010E-07_JPRB /) RAYLB = (/ & & 1.23766E-07_JPRB,1.40524E-07_JPRB,1.61610E-07_JPRB,1.83232E-07_JPRB, & & 2.02951E-07_JPRB,2.21367E-07_JPRB,2.38367E-07_JPRB,2.53019E-07_JPRB, & & 2.12202E-07_JPRB,1.36977E-07_JPRB,1.39118E-07_JPRB,1.37097E-07_JPRB, & - & 1.33223E-07_JPRB,1.38695E-07_JPRB,1.19868E-07_JPRB,1.20062E-07_JPRB /) + & 1.33223E-07_JPRB,1.38695E-07_JPRB,1.19868E-07_JPRB,1.20062E-07_JPRB /) ABSO3A = (/ & & 8.03067E-02_JPRB,0.180926_JPRB ,0.227484_JPRB ,0.168015_JPRB , & & 0.138284_JPRB ,0.114537_JPRB ,9.50114E-02_JPRB,8.06816E-02_JPRB, & & 6.76406E-02_JPRB,5.69802E-02_JPRB,5.63283E-02_JPRB,4.57592E-02_JPRB, & - & 4.21862E-02_JPRB,3.47949E-02_JPRB,2.65731E-02_JPRB,2.67628E-02_JPRB /) + & 4.21862E-02_JPRB,3.47949E-02_JPRB,2.65731E-02_JPRB,2.67628E-02_JPRB /) ABSO3B = (/ & & 2.94848E-02_JPRB,4.33642E-02_JPRB,6.70197E-02_JPRB,0.104990_JPRB , & & 0.156180_JPRB ,0.214638_JPRB ,0.266281_JPRB ,0.317941_JPRB , & & 0.355327_JPRB ,0.371241_JPRB ,0.374396_JPRB ,0.326847_JPRB , & - & 0.126497_JPRB ,6.95264E-02_JPRB,2.58175E-02_JPRB,2.52862E-02_JPRB /) + & 0.126497_JPRB ,6.95264E-02_JPRB,2.58175E-02_JPRB,2.52862E-02_JPRB /) STRRAT = 0.124692_JPRB @@ -157,12 +166,12 @@ SUBROUTINE SRTM_KGB24 ! ------------------------------------------------------------------ -! The array KA contains absorption coefs at the 16 chosen g-values +! The array KA contains absorption coefs at the 16 chosen g-values ! for a range of pressure levels> ~100mb, temperatures, and binary -! species parameters (see taumol.f for definition). The first -! index in the array, JS, runs from 1 to 9, and corresponds to -! different values of the binary species parameter. For instance, -! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, +! species parameters (see taumol.f for definition). The first +! index in the array, JS, runs from 1 to 9, and corresponds to +! different values of the binary species parameter. For instance, +! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, ! JS = 3 corresponds to the parameter value 2/8, etc. The second index ! in the array, JT, which runs from 1 to 5, corresponds to different ! temperatures. More specifically, JT = 3 means that the data are for @@ -175,13 +184,13 @@ SUBROUTINE SRTM_KGB24 ! ----------------------------------------------------------------- ! ----------------------------------------------------------------- -! The array KB contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure +! The array KB contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure ! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. ! The second index, JP, runs from 13 to 59 and refers to the JPth ! reference pressure level (see taumol.f for the value of these ! pressure levels in mb). The third index, IG, goes from 1 to 16, @@ -215,52 +224,52 @@ SUBROUTINE SRTM_KGB24 SELFREF(:, 1) = (/ & & 0.637755E-05_JPRB, 0.403921E-05_JPRB, 0.255823E-05_JPRB, 0.162025E-05_JPRB, 0.102618E-05_JPRB, & - & 0.649930E-06_JPRB, 0.411632E-06_JPRB, 0.260707E-06_JPRB, 0.165118E-06_JPRB, 0.104577E-06_JPRB /) + & 0.649930E-06_JPRB, 0.411632E-06_JPRB, 0.260707E-06_JPRB, 0.165118E-06_JPRB, 0.104577E-06_JPRB /) SELFREF(:, 2) = (/ & & 0.180887E-04_JPRB, 0.108890E-04_JPRB, 0.655493E-05_JPRB, 0.394592E-05_JPRB, 0.237536E-05_JPRB, & - & 0.142991E-05_JPRB, 0.860774E-06_JPRB, 0.518167E-06_JPRB, 0.311925E-06_JPRB, 0.187772E-06_JPRB /) + & 0.142991E-05_JPRB, 0.860774E-06_JPRB, 0.518167E-06_JPRB, 0.311925E-06_JPRB, 0.187772E-06_JPRB /) SELFREF(:, 3) = (/ & & 0.212261E-04_JPRB, 0.150697E-04_JPRB, 0.106989E-04_JPRB, 0.759581E-05_JPRB, 0.539274E-05_JPRB, & - & 0.382864E-05_JPRB, 0.271819E-05_JPRB, 0.192981E-05_JPRB, 0.137009E-05_JPRB, 0.972711E-06_JPRB /) + & 0.382864E-05_JPRB, 0.271819E-05_JPRB, 0.192981E-05_JPRB, 0.137009E-05_JPRB, 0.972711E-06_JPRB /) SELFREF(:, 4) = (/ & & 0.132497E-04_JPRB, 0.118071E-04_JPRB, 0.105216E-04_JPRB, 0.937599E-05_JPRB, 0.835516E-05_JPRB, & - & 0.744547E-05_JPRB, 0.663482E-05_JPRB, 0.591243E-05_JPRB, 0.526870E-05_JPRB, 0.469506E-05_JPRB /) + & 0.744547E-05_JPRB, 0.663482E-05_JPRB, 0.591243E-05_JPRB, 0.526870E-05_JPRB, 0.469506E-05_JPRB /) SELFREF(:, 5) = (/ & & 0.124069E-04_JPRB, 0.120785E-04_JPRB, 0.117589E-04_JPRB, 0.114477E-04_JPRB, 0.111447E-04_JPRB, & - & 0.108498E-04_JPRB, 0.105626E-04_JPRB, 0.102831E-04_JPRB, 0.100109E-04_JPRB, 0.974601E-05_JPRB /) + & 0.108498E-04_JPRB, 0.105626E-04_JPRB, 0.102831E-04_JPRB, 0.100109E-04_JPRB, 0.974601E-05_JPRB /) SELFREF(:, 6) = (/ & & 0.411994E-04_JPRB, 0.372560E-04_JPRB, 0.336901E-04_JPRB, 0.304654E-04_JPRB, 0.275494E-04_JPRB, & - & 0.249126E-04_JPRB, 0.225281E-04_JPRB, 0.203718E-04_JPRB, 0.184219E-04_JPRB, 0.166587E-04_JPRB /) + & 0.249126E-04_JPRB, 0.225281E-04_JPRB, 0.203718E-04_JPRB, 0.184219E-04_JPRB, 0.166587E-04_JPRB /) SELFREF(:, 7) = (/ & & 0.537376E-04_JPRB, 0.501002E-04_JPRB, 0.467090E-04_JPRB, 0.435473E-04_JPRB, 0.405996E-04_JPRB, & - & 0.378515E-04_JPRB, 0.352893E-04_JPRB, 0.329006E-04_JPRB, 0.306736E-04_JPRB, 0.285974E-04_JPRB /) + & 0.378515E-04_JPRB, 0.352893E-04_JPRB, 0.329006E-04_JPRB, 0.306736E-04_JPRB, 0.285974E-04_JPRB /) SELFREF(:, 8) = (/ & & 0.494279E-04_JPRB, 0.475365E-04_JPRB, 0.457175E-04_JPRB, 0.439681E-04_JPRB, 0.422857E-04_JPRB, & - & 0.406676E-04_JPRB, 0.391114E-04_JPRB, 0.376148E-04_JPRB, 0.361755E-04_JPRB, 0.347912E-04_JPRB /) + & 0.406676E-04_JPRB, 0.391114E-04_JPRB, 0.376148E-04_JPRB, 0.361755E-04_JPRB, 0.347912E-04_JPRB /) SELFREF(:, 9) = (/ & & 0.377444E-04_JPRB, 0.378199E-04_JPRB, 0.378956E-04_JPRB, 0.379715E-04_JPRB, 0.380475E-04_JPRB, & - & 0.381236E-04_JPRB, 0.381999E-04_JPRB, 0.382763E-04_JPRB, 0.383529E-04_JPRB, 0.384297E-04_JPRB /) + & 0.381236E-04_JPRB, 0.381999E-04_JPRB, 0.382763E-04_JPRB, 0.383529E-04_JPRB, 0.384297E-04_JPRB /) SELFREF(:,10) = (/ & & 0.245916E-04_JPRB, 0.267183E-04_JPRB, 0.290289E-04_JPRB, 0.315394E-04_JPRB, 0.342669E-04_JPRB, & - & 0.372304E-04_JPRB, 0.404501E-04_JPRB, 0.439483E-04_JPRB, 0.477490E-04_JPRB, 0.518784E-04_JPRB /) + & 0.372304E-04_JPRB, 0.404501E-04_JPRB, 0.439483E-04_JPRB, 0.477490E-04_JPRB, 0.518784E-04_JPRB /) SELFREF(:,11) = (/ & & 0.186528E-04_JPRB, 0.211417E-04_JPRB, 0.239628E-04_JPRB, 0.271603E-04_JPRB, 0.307845E-04_JPRB, & - & 0.348923E-04_JPRB, 0.395482E-04_JPRB, 0.448254E-04_JPRB, 0.508068E-04_JPRB, 0.575863E-04_JPRB /) + & 0.348923E-04_JPRB, 0.395482E-04_JPRB, 0.448254E-04_JPRB, 0.508068E-04_JPRB, 0.575863E-04_JPRB /) SELFREF(:,12) = (/ & & 0.109896E-04_JPRB, 0.133794E-04_JPRB, 0.162890E-04_JPRB, 0.198312E-04_JPRB, 0.241438E-04_JPRB, & - & 0.293942E-04_JPRB, 0.357864E-04_JPRB, 0.435686E-04_JPRB, 0.530432E-04_JPRB, 0.645781E-04_JPRB /) + & 0.293942E-04_JPRB, 0.357864E-04_JPRB, 0.435686E-04_JPRB, 0.530432E-04_JPRB, 0.645781E-04_JPRB /) SELFREF(:,13) = (/ & & 0.183885E-06_JPRB, 0.391019E-06_JPRB, 0.831472E-06_JPRB, 0.176806E-05_JPRB, 0.375966E-05_JPRB, & - & 0.799463E-05_JPRB, 0.170000E-04_JPRB, 0.361492E-04_JPRB, 0.768686E-04_JPRB, 0.163455E-03_JPRB /) + & 0.799463E-05_JPRB, 0.170000E-04_JPRB, 0.361492E-04_JPRB, 0.768686E-04_JPRB, 0.163455E-03_JPRB /) SELFREF(:,14) = (/ & & 0.466057E-07_JPRB, 0.937419E-07_JPRB, 0.188551E-06_JPRB, 0.379248E-06_JPRB, 0.762813E-06_JPRB, & - & 0.153431E-05_JPRB, 0.308608E-05_JPRB, 0.620729E-05_JPRB, 0.124852E-04_JPRB, 0.251126E-04_JPRB /) + & 0.153431E-05_JPRB, 0.308608E-05_JPRB, 0.620729E-05_JPRB, 0.124852E-04_JPRB, 0.251126E-04_JPRB /) SELFREF(:,15) = (/ & & 0.248961E-06_JPRB, 0.216780E-06_JPRB, 0.188758E-06_JPRB, 0.164358E-06_JPRB, 0.143113E-06_JPRB, & - & 0.124613E-06_JPRB, 0.108505E-06_JPRB, 0.944795E-07_JPRB, 0.822667E-07_JPRB, 0.716326E-07_JPRB /) + & 0.124613E-06_JPRB, 0.108505E-06_JPRB, 0.944795E-07_JPRB, 0.822667E-07_JPRB, 0.716326E-07_JPRB /) SELFREF(:,16) = (/ & & 0.252246E-06_JPRB, 0.220335E-06_JPRB, 0.192462E-06_JPRB, 0.168114E-06_JPRB, 0.146847E-06_JPRB, & - & 0.128270E-06_JPRB, 0.112043E-06_JPRB, 0.978688E-07_JPRB, 0.854878E-07_JPRB, 0.746731E-07_JPRB /) + & 0.128270E-06_JPRB, 0.112043E-06_JPRB, 0.978688E-07_JPRB, 0.854878E-07_JPRB, 0.746731E-07_JPRB /) IF (LHOOK) CALL DR_HOOK('SRTM_KGB24',1,ZHOOK_HANDLE) RETURN diff --git a/ifsrrtm/srtm_kgb25.F90 b/ifsrrtm/srtm_kgb25.F90 index 711d651a..49d52bb6 100644 --- a/ifsrrtm/srtm_kgb25.F90 +++ b/ifsrrtm/srtm_kgb25.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_KGB25 ! Originally by J.Delamere, Atmospheric & Environmental Research. @@ -11,8 +20,8 @@ SUBROUTINE SRTM_KGB25 USE PARKIND1 , ONLY : JPRB USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN_ECRAD, ONLY : NULRAD -USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC +USE YOMLUN_ECRAD,ONLY : NULRAD +USE YOMMP0_IFSAUX,ONLY : NPROC, MYPROC USE MPL_MODULE, ONLY : MPL_BROADCAST USE YOMTAG , ONLY : MTAGRAD USE YOESRTA25 , ONLY : KA, SFLUXREF, RAYL, ABSO3A, ABSO3B, LAYREFFR, KA_D @@ -40,37 +49,37 @@ SUBROUTINE SRTM_KGB25 & 42.6858_JPRB , 45.7720_JPRB, 44.9872_JPRB, 45.9662_JPRB , & & 46.5458_JPRB , 41.6926_JPRB, 32.2893_JPRB, 24.0928_JPRB , & & 16.7686_JPRB , 1.86048_JPRB, 1.54057_JPRB, 1.23503_JPRB , & - & 0.915085_JPRB,0.590099_JPRB,0.218622_JPRB, 3.21287E-02_JPRB /) + & 0.915085_JPRB,0.590099_JPRB,0.218622_JPRB, 3.21287E-02_JPRB /) ! Rayleigh extinction coefficient at v = 2925 cm-1. RAYL = (/ & & 9.81132E-07_JPRB,8.25605E-07_JPRB,6.71302E-07_JPRB,5.53556E-07_JPRB, & & 3.97383E-07_JPRB,3.68206E-07_JPRB,4.42379E-07_JPRB,4.57799E-07_JPRB, & & 4.22683E-07_JPRB,3.87113E-07_JPRB,3.79810E-07_JPRB,3.63192E-07_JPRB, & - & 3.51921E-07_JPRB,3.34231E-07_JPRB,3.34294E-07_JPRB,3.32673E-07_JPRB /) - + & 3.51921E-07_JPRB,3.34231E-07_JPRB,3.34294E-07_JPRB,3.32673E-07_JPRB /) + ABSO3A = (/ & & 2.32664E-02_JPRB,5.76154E-02_JPRB,0.125389_JPRB,0.250158_JPRB, & & 0.378756_JPRB ,0.402196_JPRB ,0.352026_JPRB,0.352036_JPRB, & & 0.386253_JPRB ,0.414598_JPRB ,0.420079_JPRB,0.435471_JPRB, & - & 0.445487_JPRB ,0.459549_JPRB ,0.452920_JPRB,0.456838_JPRB /) + & 0.445487_JPRB ,0.459549_JPRB ,0.452920_JPRB,0.456838_JPRB /) ABSO3B = (/ & & 1.76917E-02_JPRB,4.64185E-02_JPRB,1.03640E-01_JPRB,0.189469_JPRB, & & 0.303858_JPRB ,0.400248_JPRB ,0.447357_JPRB ,0.470009_JPRB, & & 0.498673_JPRB ,0.515696_JPRB ,0.517053_JPRB ,0.517930_JPRB, & - & 0.518345_JPRB ,0.524952_JPRB ,0.508244_JPRB ,0.468981_JPRB /) + & 0.518345_JPRB ,0.524952_JPRB ,0.508244_JPRB ,0.468981_JPRB /) LAYREFFR = 2 ! ------------------------------------------------------------------ -! The array KA contains absorption coefs at the 16 chosen g-values +! The array KA contains absorption coefs at the 16 chosen g-values ! for a range of pressure levels> ~100mb, temperatures, and binary -! species parameters (see taumol.f for definition). The first -! index in the array, JS, runs from 1 to 9, and corresponds to -! different values of the binary species parameter. For instance, -! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, +! species parameters (see taumol.f for definition). The first +! index in the array, JS, runs from 1 to 9, and corresponds to +! different values of the binary species parameter. For instance, +! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, ! JS = 3 corresponds to the parameter value 2/8, etc. The second index ! in the array, JT, which runs from 1 to 5, corresponds to different ! temperatures. More specifically, JT = 3 means that the data are for @@ -81,7 +90,7 @@ SUBROUTINE SRTM_KGB25 ! in mb). The fourth index, IG, goes from 1 to 16, and indicates ! which g-interval the absorption coefficients are for. ! ----------------------------------------------------------------- - + ! ----------------------------------------------------------------- IF (LHOOK) CALL DR_HOOK('SRTM_KGB25',1,ZHOOK_HANDLE) RETURN diff --git a/ifsrrtm/srtm_kgb26.F90 b/ifsrrtm/srtm_kgb26.F90 index beb49dee..f8179b28 100644 --- a/ifsrrtm/srtm_kgb26.F90 +++ b/ifsrrtm/srtm_kgb26.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_KGB26 ! Originally by J.Delamere, Atmospheric & Environmental Research. diff --git a/ifsrrtm/srtm_kgb27.F90 b/ifsrrtm/srtm_kgb27.F90 index fd018ad2..2bafbb29 100644 --- a/ifsrrtm/srtm_kgb27.F90 +++ b/ifsrrtm/srtm_kgb27.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_KGB27 ! Originally by J.Delamere, Atmospheric & Environmental Research. @@ -11,8 +20,8 @@ SUBROUTINE SRTM_KGB27 USE PARKIND1 , ONLY : JPRB USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN_ECRAD, ONLY : NULRAD -USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC +USE YOMLUN_ECRAD,ONLY : NULRAD +USE YOMMP0_IFSAUX,ONLY : NPROC, MYPROC USE MPL_MODULE, ONLY : MPL_BROADCAST USE YOMTAG , ONLY : MTAGRAD USE YOESRTA27 , ONLY : KA, KB, SFLUXREF, RAYL, SCALEKUR, LAYREFFR, & @@ -48,14 +57,14 @@ SUBROUTINE SRTM_KGB27 & 14.0526_JPRB , 11.4794_JPRB , 8.72590_JPRB , 5.56966_JPRB , & & 3.80927_JPRB , 1.57690_JPRB , 1.15099_JPRB , 1.10012_JPRB , & & 0.658212_JPRB , 5.86859E-02_JPRB, 5.56186E-02_JPRB, 4.68040E-02_JPRB, & - & 3.64897E-02_JPRB, 3.58053E-02_JPRB, 1.38130E-02_JPRB, 1.90193E-03_JPRB /) + & 3.64897E-02_JPRB, 3.58053E-02_JPRB, 1.38130E-02_JPRB, 1.90193E-03_JPRB /) ! Rayleigh extinction coefficient at v = 2925 cm-1. RAYL = (/ & & 3.44534E-06_JPRB,4.14480E-06_JPRB,4.95069E-06_JPRB,5.81204E-06_JPRB, & & 6.69748E-06_JPRB,7.56488E-06_JPRB,8.36344E-06_JPRB,9.04135E-06_JPRB, & & 9.58324E-06_JPRB,9.81542E-06_JPRB,9.75119E-06_JPRB,9.74533E-06_JPRB, & - & 9.74139E-06_JPRB,9.73525E-06_JPRB,9.73577E-06_JPRB,9.73618E-06_JPRB /) + & 9.74139E-06_JPRB,9.73525E-06_JPRB,9.73577E-06_JPRB,9.73618E-06_JPRB /) SCALEKUR = 50.15_JPRB/48.37_JPRB @@ -63,12 +72,12 @@ SUBROUTINE SRTM_KGB27 ! ------------------------------------------------------------------ -! The array KA contains absorption coefs at the 16 chosen g-values +! The array KA contains absorption coefs at the 16 chosen g-values ! for a range of pressure levels> ~100mb, temperatures, and binary -! species parameters (see taumol.f for definition). The first -! index in the array, JS, runs from 1 to 9, and corresponds to -! different values of the binary species parameter. For instance, -! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, +! species parameters (see taumol.f for definition). The first +! index in the array, JS, runs from 1 to 9, and corresponds to +! different values of the binary species parameter. For instance, +! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, ! JS = 3 corresponds to the parameter value 2/8, etc. The second index ! in the array, JT, which runs from 1 to 5, corresponds to different ! temperatures. More specifically, JT = 3 means that the data are for @@ -81,20 +90,20 @@ SUBROUTINE SRTM_KGB27 ! ----------------------------------------------------------------- ! ----------------------------------------------------------------- -! The array KB contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure +! The array KB contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure ! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. ! The second index, JP, runs from 13 to 59 and refers to the JPth ! reference pressure level (see taumol.f for the value of these ! pressure levels in mb). The third index, IG, goes from 1 to 16, ! and tells us which g-interval the absorption coefficients are for. ! ----------------------------------------------------------------- - - + + ! ----------------------------------------------------------------- IF (LHOOK) CALL DR_HOOK('SRTM_KGB27',1,ZHOOK_HANDLE) RETURN diff --git a/ifsrrtm/srtm_kgb28.F90 b/ifsrrtm/srtm_kgb28.F90 index 4b4bc584..b76051ab 100644 --- a/ifsrrtm/srtm_kgb28.F90 +++ b/ifsrrtm/srtm_kgb28.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_KGB28 ! Originally by J.Delamere, Atmospheric & Environmental Research. @@ -12,8 +21,8 @@ SUBROUTINE SRTM_KGB28 USE PARKIND1 , ONLY : JPRB USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN_ECRAD, ONLY : NULRAD -USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC +USE YOMLUN_ECRAD,ONLY : NULRAD +USE YOMMP0_IFSAUX,ONLY : NPROC, MYPROC USE MPL_MODULE, ONLY : MPL_BROADCAST USE YOMTAG , ONLY : MTAGRAD USE YOESRTA28 , ONLY : KA, KB, SFLUXREF, RAYL, STRRAT, LAYREFFR, KA_D, KB_D @@ -43,27 +52,27 @@ SUBROUTINE SRTM_KGB28 & 1.06156_JPRB , 0.599910_JPRB , 0.422462_JPRB , 0.400077_JPRB , & & 0.282221_JPRB , 0.187893_JPRB , 6.77357E-02_JPRB, 3.04572E-02_JPRB, & & 2.00442E-02_JPRB, 2.30786E-03_JPRB, 2.08824E-03_JPRB, 1.42604E-03_JPRB, & - & 9.67384E-04_JPRB, 6.35362E-04_JPRB, 1.47727E-04_JPRB, 6.87639E-06_JPRB /) + & 9.67384E-04_JPRB, 6.35362E-04_JPRB, 1.47727E-04_JPRB, 6.87639E-06_JPRB /) SFLUXREF(:,2) = (/ & & 1.07598_JPRB , 0.585099_JPRB , 0.422852_JPRB , 0.400077_JPRB , & & 0.282221_JPRB , 0.187893_JPRB , 6.69686E-02_JPRB, 3.09070E-02_JPRB, & & 2.02400E-02_JPRB, 2.47760E-03_JPRB, 1.89411E-03_JPRB, 1.41122E-03_JPRB, & - & 1.12449E-03_JPRB, 5.73505E-04_JPRB, 2.04160E-04_JPRB, 1.58371E-05_JPRB /) + & 1.12449E-03_JPRB, 5.73505E-04_JPRB, 2.04160E-04_JPRB, 1.58371E-05_JPRB /) SFLUXREF(:,3) = (/ & & 0.461647_JPRB , 0.406113_JPRB , 0.332506_JPRB , 0.307508_JPRB , & & 0.211167_JPRB , 0.235457_JPRB , 0.495886_JPRB , 0.363921_JPRB , & & 0.192700_JPRB , 2.04678E-02_JPRB, 1.55407E-02_JPRB, 1.03882E-02_JPRB, & - & 1.10778E-02_JPRB, 1.00504E-02_JPRB, 4.93497E-03_JPRB, 5.73410E-04_JPRB /) + & 1.10778E-02_JPRB, 1.00504E-02_JPRB, 4.93497E-03_JPRB, 5.73410E-04_JPRB /) SFLUXREF(:,4) = (/ & & 0.132669_JPRB , 0.175058_JPRB , 0.359263_JPRB , 0.388142_JPRB , & & 0.350359_JPRB , 0.475892_JPRB , 0.489593_JPRB , 0.408437_JPRB , & & 0.221049_JPRB , 1.94514E-02_JPRB, 1.54848E-02_JPRB, 1.44999E-02_JPRB, & - & 1.44568E-02_JPRB, 1.00527E-02_JPRB, 4.95897E-03_JPRB, 5.73327E-04_JPRB /) + & 1.44568E-02_JPRB, 1.00527E-02_JPRB, 4.95897E-03_JPRB, 5.73327E-04_JPRB /) SFLUXREF(:,5) = (/ & & 7.54800E-02_JPRB, 0.232246_JPRB , 0.359263_JPRB , 0.388142_JPRB , & & 0.350359_JPRB , 0.426317_JPRB , 0.493485_JPRB , 0.432016_JPRB , & & 0.239203_JPRB , 1.74951E-02_JPRB, 1.74477E-02_JPRB, 1.83566E-02_JPRB, & - & 1.44818E-02_JPRB, 1.01048E-02_JPRB, 4.97487E-03_JPRB, 5.66831E-04_JPRB /) + & 1.44818E-02_JPRB, 1.01048E-02_JPRB, 4.97487E-03_JPRB, 5.66831E-04_JPRB /) ! Rayleigh extinction coefficient at v = ????? cm-1. RAYL = 2.02E-05_JPRB @@ -74,12 +83,12 @@ SUBROUTINE SRTM_KGB28 ! ------------------------------------------------------------------ -! The array KA contains absorption coefs at the 16 chosen g-values +! The array KA contains absorption coefs at the 16 chosen g-values ! for a range of pressure levels> ~100mb, temperatures, and binary -! species parameters (see taumol.f for definition). The first -! index in the array, JS, runs from 1 to 9, and corresponds to -! different values of the binary species parameter. For instance, -! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, +! species parameters (see taumol.f for definition). The first +! index in the array, JS, runs from 1 to 9, and corresponds to +! different values of the binary species parameter. For instance, +! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, ! JS = 3 corresponds to the parameter value 2/8, etc. The second index ! in the array, JT, which runs from 1 to 5, corresponds to different ! temperatures. More specifically, JT = 3 means that the data are for @@ -92,13 +101,13 @@ SUBROUTINE SRTM_KGB28 ! ----------------------------------------------------------------- ! ----------------------------------------------------------------- -! The array KB contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure +! The array KB contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure ! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. ! The second index, JP, runs from 13 to 59 and refers to the JPth ! reference pressure level (see taumol.f for the value of these ! pressure levels in mb). The third index, IG, goes from 1 to 16, diff --git a/ifsrrtm/srtm_kgb29.F90 b/ifsrrtm/srtm_kgb29.F90 index 2d59b0cf..f94afa00 100644 --- a/ifsrrtm/srtm_kgb29.F90 +++ b/ifsrrtm/srtm_kgb29.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_KGB29 ! Originally by J.Delamere, Atmospheric & Environmental Research. @@ -11,8 +20,8 @@ SUBROUTINE SRTM_KGB29 USE PARKIND1 , ONLY : JPRB USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK -USE YOMLUN_ECRAD, ONLY : NULRAD -USE YOMMP0_IFSAUX , ONLY : NPROC, MYPROC +USE YOMLUN_ECRAD,ONLY : NULRAD +USE YOMMP0_IFSAUX,ONLY : NPROC, MYPROC USE MPL_MODULE, ONLY : MPL_BROADCAST USE YOMTAG , ONLY : MTAGRAD USE YOESRTA29 , ONLY : KA, KB, SELFREF, FORREF, SFLUXREF, RAYL, & @@ -44,20 +53,20 @@ SUBROUTINE SRTM_KGB29 & 1.32880_JPRB , 2.14018_JPRB , 1.97612_JPRB , 1.79000_JPRB , & & 1.51242_JPRB , 1.22977_JPRB , 1.06052_JPRB , 0.800996_JPRB , & & 0.748053_JPRB , 8.64369E-02_JPRB, 7.10675E-02_JPRB, 5.62425E-02_JPRB, & - & 4.46988E-02_JPRB, 3.07441E-02_JPRB, 1.16728E-02_JPRB, 1.65573E-03_JPRB /) + & 4.46988E-02_JPRB, 3.07441E-02_JPRB, 1.16728E-02_JPRB, 1.65573E-03_JPRB /) ABSCO2 = (/ & & 2.90073E-06_JPRB, 2.12382E-05_JPRB, 1.03032E-04_JPRB, 1.86481E-04_JPRB, & & 4.31997E-04_JPRB, 6.08238E-04_JPRB, 2.17603E-03_JPRB, 4.64479E-02_JPRB, & & 2.96956_JPRB , 14.9569_JPRB , 28.4831_JPRB , 61.3998_JPRB , & - & 164.129_JPRB , 832.282_JPRB , 4995.02_JPRB , 12678.1_JPRB /) - + & 164.129_JPRB , 832.282_JPRB , 4995.02_JPRB , 12678.1_JPRB /) + ABSH2O = (/ & & 2.99508E-04_JPRB, 3.95012E-03_JPRB, 1.49316E-02_JPRB, 3.24384E-02_JPRB, & & 6.92879E-02_JPRB, 0.123523_JPRB , 0.360985_JPRB , 1.86434_JPRB , & & 10.38157_JPRB , 0.214129_JPRB , 0.213914_JPRB , 0.212781_JPRB , & - & 0.215562_JPRB , 0.218087_JPRB , 0.220918_JPRB , 0.218546_JPRB /) - + & 0.215562_JPRB , 0.218087_JPRB , 0.220918_JPRB , 0.218546_JPRB /) + ! Rayleigh extinction coefficient at v = 2200 cm-1. RAYL = 9.30E-11_JPRB @@ -65,12 +74,12 @@ SUBROUTINE SRTM_KGB29 ! ------------------------------------------------------------------ -! The array KA contains absorption coefs at the 16 chosen g-values +! The array KA contains absorption coefs at the 16 chosen g-values ! for a range of pressure levels> ~100mb, temperatures, and binary -! species parameters (see taumol.f for definition). The first -! index in the array, JS, runs from 1 to 9, and corresponds to -! different values of the binary species parameter. For instance, -! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, +! species parameters (see taumol.f for definition). The first +! index in the array, JS, runs from 1 to 9, and corresponds to +! different values of the binary species parameter. For instance, +! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, ! JS = 3 corresponds to the parameter value 2/8, etc. The second index ! in the array, JT, which runs from 1 to 5, corresponds to different ! temperatures. More specifically, JT = 3 means that the data are for @@ -83,13 +92,13 @@ SUBROUTINE SRTM_KGB29 ! ----------------------------------------------------------------- ! ----------------------------------------------------------------- -! The array KB contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure +! The array KB contains absorption coefs at the 16 chosen g-values +! for a range of pressure levels < ~100mb and temperatures. The first +! index in the array, JT, which runs from 1 to 5, corresponds to +! different temperatures. More specifically, JT = 3 means that the +! data are for the reference temperature TREF for this pressure ! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. +! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. ! The second index, JP, runs from 13 to 59 and refers to the JPth ! reference pressure level (see taumol.f for the value of these ! pressure levels in mb). The third index, IG, goes from 1 to 16, @@ -123,53 +132,53 @@ SUBROUTINE SRTM_KGB29 SELFREF(:, 1) = (/ & & 0.118069E+00_JPRB, 0.713523E-01_JPRB, 0.431199E-01_JPRB, 0.260584E-01_JPRB, 0.157477E-01_JPRB, & - & 0.951675E-02_JPRB, 0.575121E-02_JPRB, 0.347560E-02_JPRB, 0.210039E-02_JPRB, 0.126932E-02_JPRB /) + & 0.951675E-02_JPRB, 0.575121E-02_JPRB, 0.347560E-02_JPRB, 0.210039E-02_JPRB, 0.126932E-02_JPRB /) SELFREF(:, 2) = (/ & & 0.137081E-01_JPRB, 0.139046E-01_JPRB, 0.141040E-01_JPRB, 0.143061E-01_JPRB, 0.145112E-01_JPRB, & - & 0.147193E-01_JPRB, 0.149303E-01_JPRB, 0.151443E-01_JPRB, 0.153614E-01_JPRB, 0.155816E-01_JPRB /) + & 0.147193E-01_JPRB, 0.149303E-01_JPRB, 0.151443E-01_JPRB, 0.153614E-01_JPRB, 0.155816E-01_JPRB /) SELFREF(:, 3) = (/ & & 0.166575E-01_JPRB, 0.164916E-01_JPRB, 0.163273E-01_JPRB, 0.161647E-01_JPRB, 0.160037E-01_JPRB, & - & 0.158443E-01_JPRB, 0.156864E-01_JPRB, 0.155302E-01_JPRB, 0.153755E-01_JPRB, 0.152224E-01_JPRB /) + & 0.158443E-01_JPRB, 0.156864E-01_JPRB, 0.155302E-01_JPRB, 0.153755E-01_JPRB, 0.152224E-01_JPRB /) SELFREF(:, 4) = (/ & & 0.597379E-01_JPRB, 0.509517E-01_JPRB, 0.434579E-01_JPRB, 0.370662E-01_JPRB, 0.316145E-01_JPRB, & - & 0.269647E-01_JPRB, 0.229988E-01_JPRB, 0.196162E-01_JPRB, 0.167311E-01_JPRB, 0.142703E-01_JPRB /) + & 0.269647E-01_JPRB, 0.229988E-01_JPRB, 0.196162E-01_JPRB, 0.167311E-01_JPRB, 0.142703E-01_JPRB /) SELFREF(:, 5) = (/ & & 0.227517E+00_JPRB, 0.198401E+00_JPRB, 0.173011E+00_JPRB, 0.150870E+00_JPRB, 0.131563E+00_JPRB, & - & 0.114726E+00_JPRB, 0.100044E+00_JPRB, 0.872415E-01_JPRB, 0.760769E-01_JPRB, 0.663411E-01_JPRB /) + & 0.114726E+00_JPRB, 0.100044E+00_JPRB, 0.872415E-01_JPRB, 0.760769E-01_JPRB, 0.663411E-01_JPRB /) SELFREF(:, 6) = (/ & & 0.453235E+00_JPRB, 0.414848E+00_JPRB, 0.379712E+00_JPRB, 0.347552E+00_JPRB, 0.318116E+00_JPRB, & - & 0.291173E+00_JPRB, 0.266512E+00_JPRB, 0.243940E+00_JPRB, 0.223279E+00_JPRB, 0.204368E+00_JPRB /) + & 0.291173E+00_JPRB, 0.266512E+00_JPRB, 0.243940E+00_JPRB, 0.223279E+00_JPRB, 0.204368E+00_JPRB /) SELFREF(:, 7) = (/ & & 0.569263E+00_JPRB, 0.516415E+00_JPRB, 0.468473E+00_JPRB, 0.424982E+00_JPRB, 0.385528E+00_JPRB, & - & 0.349737E+00_JPRB, 0.317269E+00_JPRB, 0.287815E+00_JPRB, 0.261095E+00_JPRB, 0.236856E+00_JPRB /) + & 0.349737E+00_JPRB, 0.317269E+00_JPRB, 0.287815E+00_JPRB, 0.261095E+00_JPRB, 0.236856E+00_JPRB /) SELFREF(:, 8) = (/ & & 0.490314E+00_JPRB, 0.448042E+00_JPRB, 0.409413E+00_JPRB, 0.374116E+00_JPRB, 0.341861E+00_JPRB, & - & 0.312387E+00_JPRB, 0.285455E+00_JPRB, 0.260844E+00_JPRB, 0.238355E+00_JPRB, 0.217805E+00_JPRB /) + & 0.312387E+00_JPRB, 0.285455E+00_JPRB, 0.260844E+00_JPRB, 0.238355E+00_JPRB, 0.217805E+00_JPRB /) SELFREF(:, 9) = (/ & & 0.258162E+00_JPRB, 0.265085E+00_JPRB, 0.272193E+00_JPRB, 0.279493E+00_JPRB, 0.286988E+00_JPRB, & - & 0.294684E+00_JPRB, 0.302586E+00_JPRB, 0.310701E+00_JPRB, 0.319033E+00_JPRB, 0.327588E+00_JPRB /) + & 0.294684E+00_JPRB, 0.302586E+00_JPRB, 0.310701E+00_JPRB, 0.319033E+00_JPRB, 0.327588E+00_JPRB /) SELFREF(:,10) = (/ & & 0.332019E+00_JPRB, 0.331902E+00_JPRB, 0.331784E+00_JPRB, 0.331666E+00_JPRB, 0.331549E+00_JPRB, & - & 0.331431E+00_JPRB, 0.331314E+00_JPRB, 0.331197E+00_JPRB, 0.331079E+00_JPRB, 0.330962E+00_JPRB /) + & 0.331431E+00_JPRB, 0.331314E+00_JPRB, 0.331197E+00_JPRB, 0.331079E+00_JPRB, 0.330962E+00_JPRB /) SELFREF(:,11) = (/ & & 0.357523E+00_JPRB, 0.353154E+00_JPRB, 0.348839E+00_JPRB, 0.344576E+00_JPRB, 0.340366E+00_JPRB, & - & 0.336207E+00_JPRB, 0.332099E+00_JPRB, 0.328041E+00_JPRB, 0.324032E+00_JPRB, 0.320073E+00_JPRB /) + & 0.336207E+00_JPRB, 0.332099E+00_JPRB, 0.328041E+00_JPRB, 0.324032E+00_JPRB, 0.320073E+00_JPRB /) SELFREF(:,12) = (/ & & 0.294662E+00_JPRB, 0.299043E+00_JPRB, 0.303488E+00_JPRB, 0.308000E+00_JPRB, 0.312579E+00_JPRB, & - & 0.317226E+00_JPRB, 0.321941E+00_JPRB, 0.326727E+00_JPRB, 0.331585E+00_JPRB, 0.336514E+00_JPRB /) + & 0.317226E+00_JPRB, 0.321941E+00_JPRB, 0.326727E+00_JPRB, 0.331585E+00_JPRB, 0.336514E+00_JPRB /) SELFREF(:,13) = (/ & & 0.227445E+00_JPRB, 0.241545E+00_JPRB, 0.256519E+00_JPRB, 0.272422E+00_JPRB, 0.289311E+00_JPRB, & - & 0.307247E+00_JPRB, 0.326294E+00_JPRB, 0.346523E+00_JPRB, 0.368005E+00_JPRB, 0.390820E+00_JPRB /) + & 0.307247E+00_JPRB, 0.326294E+00_JPRB, 0.346523E+00_JPRB, 0.368005E+00_JPRB, 0.390820E+00_JPRB /) SELFREF(:,14) = (/ & & 0.616203E-02_JPRB, 0.113523E-01_JPRB, 0.209144E-01_JPRB, 0.385307E-01_JPRB, 0.709852E-01_JPRB, & - & 0.130776E+00_JPRB, 0.240929E+00_JPRB, 0.443865E+00_JPRB, 0.817733E+00_JPRB, 0.150651E+01_JPRB /) + & 0.130776E+00_JPRB, 0.240929E+00_JPRB, 0.443865E+00_JPRB, 0.817733E+00_JPRB, 0.150651E+01_JPRB /) SELFREF(:,15) = (/ & & 0.279552E-03_JPRB, 0.808472E-03_JPRB, 0.233812E-02_JPRB, 0.676192E-02_JPRB, 0.195557E-01_JPRB, & - & 0.565555E-01_JPRB, 0.163560E+00_JPRB, 0.473020E+00_JPRB, 0.136799E+01_JPRB, 0.395626E+01_JPRB /) + & 0.565555E-01_JPRB, 0.163560E+00_JPRB, 0.473020E+00_JPRB, 0.136799E+01_JPRB, 0.395626E+01_JPRB /) SELFREF(:,16) = (/ & & 0.261006E-03_JPRB, 0.771043E-03_JPRB, 0.227776E-02_JPRB, 0.672879E-02_JPRB, 0.198777E-01_JPRB, & - & 0.587212E-01_JPRB, 0.173470E+00_JPRB, 0.512452E+00_JPRB, 0.151385E+01_JPRB, 0.447209E+01_JPRB /) - + & 0.587212E-01_JPRB, 0.173470E+00_JPRB, 0.512452E+00_JPRB, 0.151385E+01_JPRB, 0.447209E+01_JPRB /) + ! ----------------------------------------------------------------- IF (LHOOK) CALL DR_HOOK('SRTM_KGB29',1,ZHOOK_HANDLE) RETURN diff --git a/ifsrrtm/srtm_setcoef.F90 b/ifsrrtm/srtm_setcoef.F90 index 381c591c..013d6191 100644 --- a/ifsrrtm/srtm_setcoef.F90 +++ b/ifsrrtm/srtm_setcoef.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_SETCOEF & & ( KIDIA , KFDIA , KLEV ,& & PAVEL , PTAVEL ,& diff --git a/ifsrrtm/srtm_taumol16.F90 b/ifsrrtm/srtm_taumol16.F90 index 4b91b003..fe08798a 100644 --- a/ifsrrtm/srtm_taumol16.F90 +++ b/ifsrrtm/srtm_taumol16.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_TAUMOL16 & & ( KIDIA , KFDIA , KLEV,& & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,& @@ -58,10 +67,10 @@ SUBROUTINE SRTM_TAUMOL16 & !- from PRECISE !- from PROFDATA !- from SELF -INTEGER(KIND=JPIM) :: IG, IND0, IND1, INDS, INDF, JS, I_LAY, I_LAYSOLFR(KIDIA:KFDIA), I_NLAYERS, IPLON +INTEGER(KIND=JPIM) :: IG, IND0, IND1, INDS, INDF, JS, I_LAY, I_LAYSOLFR, I_NLAYERS, IPLON REAL(KIND=JPRB) :: Z_FAC000, Z_FAC001, Z_FAC010, Z_FAC011, Z_FAC100, Z_FAC101,& - & Z_FAC110, Z_FAC111, Z_FS, Z_SPECCOMB, Z_SPECMULT, Z_SPECPARM, & + & Z_FAC110, Z_FAC111, Z_FS, Z_SPECCOMB, Z_SPECMULT, Z_SPECPARM,& & Z_TAURAY REAL(KIND=JPHOOK) :: ZHOOK_HANDLE @@ -99,7 +108,7 @@ SUBROUTINE SRTM_TAUMOL16 & ! print 9001,LAY,IND0,IND1,INDS,INDF,FAC000,FAC010,FAC100,FAC110,FAC001,FAC011,FAC101,FAC111 & ! &,TAURAY,SELFFAC(LAY),SELFFRAC(LAY),FORFAC(LAY),FORFRAC(LAY) -9001 format(1x,'T16 ',5I4,13E12.3) +9001 FORMAT(1X,'T16 ',5I4,13E12.3) ! DO IG = 1, NG(16) !CDIR UNROLL=NG16 @@ -136,21 +145,21 @@ SUBROUTINE SRTM_TAUMOL16 & ! print 9002,LAY,IG,ABSA(IND0,IG),ABSA(IND0+1,IG),ABSA(IND0+9,IG),ABSA(IND0+10,IG) & ! &, ABSA(IND1,IG),ABSA(IND1+1,IG),ABSA(IND1+9,IG),ABSA(IND1+10,IG) & ! &, SELFREFC(INDS+1,IG),SELFREFC(INDS,IG),FORREFC(INDF+1,IG),FORREFC(INDF,IG) -9002 format(1x,'U16 ',2I3,12E12.3) +9002 FORMAT(1X,'U16 ',2I3,12E12.3) ENDDO ENDIF ENDIF ENDDO ENDDO -I_LAYSOLFR(:) = I_NLAYERS +I_LAYSOLFR = I_NLAYERS DO I_LAY = 1, I_NLAYERS DO IPLON = KIDIA, KFDIA IF (PRMU0(IPLON) > 0.0_JPRB) THEN IF (I_LAY >= K_LAYTROP(IPLON)+1) THEN IF (K_JP(IPLON,I_LAY-1) < LAYREFFR .AND. K_JP(IPLON,I_LAY) >= LAYREFFR) & - & I_LAYSOLFR(IPLON) = I_LAY + & I_LAYSOLFR = I_LAY IND0 = ((K_JP(IPLON,I_LAY)-13)*5+(K_JT(IPLON,I_LAY)-1))*NSPB(16) + 1 IND1 = ((K_JP(IPLON,I_LAY)-12)*5+(K_JT1(IPLON,I_LAY)-1))*NSPB(16) + 1 Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYL @@ -165,7 +174,7 @@ SUBROUTINE SRTM_TAUMOL16 & & P_FAC11(IPLON,I_LAY) * ABSB(IND1+1,IG)) ! & + TAURAY ! SSA(LAY,IG) = TAURAY/TAUG(LAY,IG) - IF (I_LAY == I_LAYSOLFR(IPLON)) P_SFLUXZEN(IPLON,IG) = SFLUXREFC(IG) + IF (I_LAY == I_LAYSOLFR) P_SFLUXZEN(IPLON,IG) = SFLUXREFC(IG) P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY ENDDO ENDIF @@ -175,10 +184,10 @@ SUBROUTINE SRTM_TAUMOL16 & !DO LAY=1,NLAYERS ! print 9003,LAY,(TAUG(LAY,IG),IG=1,NG16) -9003 format(1x,'O16 ',I3,16E13.5) +9003 FORMAT(1X,'O16 ',I3,16E13.5) !END DO !---------------------------------------------------------------------- -IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL16',1,ZHOOK_HANDLE) +IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL16',1,ZHOOK_HANDLE) END SUBROUTINE SRTM_TAUMOL16 diff --git a/ifsrrtm/srtm_taumol17.F90 b/ifsrrtm/srtm_taumol17.F90 index 867a0d55..339961f9 100644 --- a/ifsrrtm/srtm_taumol17.F90 +++ b/ifsrrtm/srtm_taumol17.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_TAUMOL17 & & ( KIDIA , KFDIA , KLEV,& & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,& @@ -58,7 +67,7 @@ SUBROUTINE SRTM_TAUMOL17 & !- from PRECISE !- from PROFDATA !- from SELF -INTEGER(KIND=JPIM) :: IG, IND0, IND1, INDS, INDF, JS, I_LAY, I_LAYSOLFR(KIDIA:KFDIA), I_NLAYERS, IPLON +INTEGER(KIND=JPIM) :: IG, IND0, IND1, INDS, INDF, JS, I_LAY, I_LAYSOLFR, I_NLAYERS, IPLON ! REAL(KIND=JPRB) :: Z_FAC000, Z_FAC001, Z_FAC010, Z_FAC011, Z_FAC100, Z_FAC101,& ! & Z_FAC110, Z_FAC111 @@ -67,6 +76,7 @@ SUBROUTINE SRTM_TAUMOL17 & IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL17',0,ZHOOK_HANDLE) + I_NLAYERS = KLEV ! Compute the optical depth by interpolating in ln(pressure), @@ -128,14 +138,14 @@ SUBROUTINE SRTM_TAUMOL17 & ENDDO ENDDO -I_LAYSOLFR(:) = I_NLAYERS +I_LAYSOLFR = I_NLAYERS DO I_LAY = 1, I_NLAYERS DO IPLON = KIDIA, KFDIA IF (PRMU0(IPLON) > 0.0_JPRB) THEN IF (I_LAY >= K_LAYTROP(IPLON)+1) THEN IF (K_JP(IPLON,I_LAY-1) < LAYREFFR .AND. K_JP(IPLON,I_LAY) >= LAYREFFR) & - & I_LAYSOLFR(IPLON) = I_LAY + & I_LAYSOLFR = I_LAY Z_SPECCOMB = P_COLH2O(IPLON,I_LAY) + STRRAT*P_COLCO2(IPLON,I_LAY) Z_SPECPARM = P_COLH2O(IPLON,I_LAY)/Z_SPECCOMB IF (Z_SPECPARM >= P_ONEMINUS(IPLON)) Z_SPECPARM = P_ONEMINUS(IPLON) @@ -183,7 +193,7 @@ SUBROUTINE SRTM_TAUMOL17 & & (FORREFC(INDF+1,IG) - FORREFC(INDF,IG))) ! & + TAURAY ! SSA(LAY,IG) = TAURAY/TAUG(LAY,IG) - IF (I_LAY == I_LAYSOLFR(IPLON)) P_SFLUXZEN(IPLON,IG) = SFLUXREFC(IG,JS) & + IF (I_LAY == I_LAYSOLFR) P_SFLUXZEN(IPLON,IG) = SFLUXREFC(IG,JS) & & + Z_FS * (SFLUXREFC(IG,JS+1) - SFLUXREFC(IG,JS)) P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY ENDDO @@ -193,6 +203,6 @@ SUBROUTINE SRTM_TAUMOL17 & ENDDO !----------------------------------------------------------------------- -IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL17',1,ZHOOK_HANDLE) +IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL17',1,ZHOOK_HANDLE) END SUBROUTINE SRTM_TAUMOL17 diff --git a/ifsrrtm/srtm_taumol18.F90 b/ifsrrtm/srtm_taumol18.F90 index 5ed57452..14c9bb79 100644 --- a/ifsrrtm/srtm_taumol18.F90 +++ b/ifsrrtm/srtm_taumol18.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_TAUMOL18 & & ( KIDIA , KFDIA , KLEV,& & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,& diff --git a/ifsrrtm/srtm_taumol19.F90 b/ifsrrtm/srtm_taumol19.F90 index daed791c..4eb97b9e 100644 --- a/ifsrrtm/srtm_taumol19.F90 +++ b/ifsrrtm/srtm_taumol19.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_TAUMOL19 & & ( KIDIA , KFDIA , KLEV,& & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,& diff --git a/ifsrrtm/srtm_taumol20.F90 b/ifsrrtm/srtm_taumol20.F90 index 1b51dc8a..3b9be142 100644 --- a/ifsrrtm/srtm_taumol20.F90 +++ b/ifsrrtm/srtm_taumol20.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_TAUMOL20 & & ( KIDIA , KFDIA , KLEV,& & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,& diff --git a/ifsrrtm/srtm_taumol21.F90 b/ifsrrtm/srtm_taumol21.F90 index ca114bdf..1f01b7f8 100644 --- a/ifsrrtm/srtm_taumol21.F90 +++ b/ifsrrtm/srtm_taumol21.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_TAUMOL21 & & ( KIDIA , KFDIA , KLEV,& & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,& diff --git a/ifsrrtm/srtm_taumol22.F90 b/ifsrrtm/srtm_taumol22.F90 index 2c677bf7..c94dfdb8 100644 --- a/ifsrrtm/srtm_taumol22.F90 +++ b/ifsrrtm/srtm_taumol22.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_TAUMOL22 & & ( KIDIA , KFDIA , KLEV,& & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,& diff --git a/ifsrrtm/srtm_taumol23.F90 b/ifsrrtm/srtm_taumol23.F90 index ece72db1..f09ad46d 100644 --- a/ifsrrtm/srtm_taumol23.F90 +++ b/ifsrrtm/srtm_taumol23.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_TAUMOL23 & & ( KIDIA , KFDIA , KLEV,& & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,& diff --git a/ifsrrtm/srtm_taumol24.F90 b/ifsrrtm/srtm_taumol24.F90 index c4c68cf9..545bdeb0 100644 --- a/ifsrrtm/srtm_taumol24.F90 +++ b/ifsrrtm/srtm_taumol24.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_TAUMOL24 & & ( KIDIA , KFDIA , KLEV,& & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,& diff --git a/ifsrrtm/srtm_taumol25.F90 b/ifsrrtm/srtm_taumol25.F90 index eadf47d3..4d631c0d 100644 --- a/ifsrrtm/srtm_taumol25.F90 +++ b/ifsrrtm/srtm_taumol25.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_TAUMOL25 & & ( KIDIA , KFDIA , KLEV,& & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,& diff --git a/ifsrrtm/srtm_taumol26.F90 b/ifsrrtm/srtm_taumol26.F90 index 4395f326..b567590a 100644 --- a/ifsrrtm/srtm_taumol26.F90 +++ b/ifsrrtm/srtm_taumol26.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_TAUMOL26 & & ( KIDIA , KFDIA , KLEV,& & P_COLMOL ,K_LAYTROP,& diff --git a/ifsrrtm/srtm_taumol27.F90 b/ifsrrtm/srtm_taumol27.F90 index 6211e3c6..6d5b410a 100644 --- a/ifsrrtm/srtm_taumol27.F90 +++ b/ifsrrtm/srtm_taumol27.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_TAUMOL27 & & ( KIDIA , KFDIA , KLEV,& & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,& @@ -50,9 +59,10 @@ SUBROUTINE SRTM_TAUMOL27 & !- from PRECISE !- from PROFDATA !- from SELF -INTEGER(KIND=JPIM) :: IG, IND0, IND1, I_LAY, I_LAYSOLFR(KIDIA:KFDIA), I_NLAYERS, IPLON +INTEGER(KIND=JPIM) :: IG, IND0, IND1, I_LAY, I_LAYSOLFR, I_NLAYERS, IPLON -REAL(KIND=JPRB) :: Z_TAURAY +REAL(KIND=JPRB) ::& + & Z_TAURAY REAL(KIND=JPHOOK) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL27',0,ZHOOK_HANDLE) @@ -87,14 +97,14 @@ SUBROUTINE SRTM_TAUMOL27 & ENDDO ENDDO -I_LAYSOLFR(:) = I_NLAYERS +I_LAYSOLFR = I_NLAYERS DO I_LAY = 1, I_NLAYERS DO IPLON = KIDIA, KFDIA IF (PRMU0(IPLON) > 0.0_JPRB) THEN IF (I_LAY >= K_LAYTROP(IPLON)+1) THEN IF (K_JP(IPLON,I_LAY-1) < LAYREFFR .AND. K_JP(IPLON,I_LAY) >= LAYREFFR) & - & I_LAYSOLFR(IPLON) = I_LAY + & I_LAYSOLFR = I_LAY IND0 = ((K_JP(IPLON,I_LAY)-13)*5+(K_JT(IPLON,I_LAY)-1))*NSPB(27) + 1 IND1 = ((K_JP(IPLON,I_LAY)-12)*5+(K_JT1(IPLON,I_LAY)-1))*NSPB(27) + 1 @@ -109,7 +119,7 @@ SUBROUTINE SRTM_TAUMOL27 & & P_FAC11(IPLON,I_LAY) * ABSB(IND1+1,IG)) ! & + TAURAY ! SSA(LAY,IG) = TAURAY/TAUG(LAY,IG) - IF (I_LAY == I_LAYSOLFR(IPLON)) P_SFLUXZEN(IPLON,IG) = SCALEKUR * SFLUXREFC(IG) + IF (I_LAY == I_LAYSOLFR) P_SFLUXZEN(IPLON,IG) = SCALEKUR * SFLUXREFC(IG) P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY ENDDO ENDIF @@ -118,6 +128,6 @@ SUBROUTINE SRTM_TAUMOL27 & ENDDO !----------------------------------------------------------------------- -IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL27',1,ZHOOK_HANDLE) +IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL27',1,ZHOOK_HANDLE) END SUBROUTINE SRTM_TAUMOL27 diff --git a/ifsrrtm/srtm_taumol28.F90 b/ifsrrtm/srtm_taumol28.F90 index ab055ef8..bf680326 100644 --- a/ifsrrtm/srtm_taumol28.F90 +++ b/ifsrrtm/srtm_taumol28.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_TAUMOL28 & & ( KIDIA , KFDIA , KLEV,& & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,& @@ -52,10 +61,10 @@ SUBROUTINE SRTM_TAUMOL28 & !- from PRECISE !- from PROFDATA !- from SELF -INTEGER(KIND=JPIM) :: IG, IND0, IND1, JS, I_LAY, I_LAYSOLFR(KIDIA:KFDIA), I_NLAYERS, IPLON +INTEGER(KIND=JPIM) :: IG, IND0, IND1, JS, I_LAY, I_LAYSOLFR, I_NLAYERS, IPLON REAL(KIND=JPRB) :: Z_FAC000, Z_FAC001, Z_FAC010, Z_FAC011, Z_FAC100, Z_FAC101,& - & Z_FAC110, Z_FAC111, Z_FS, Z_SPECCOMB, Z_SPECMULT, Z_SPECPARM, & + & Z_FAC110, Z_FAC111, Z_FS, Z_SPECCOMB, Z_SPECMULT, Z_SPECPARM,& & Z_TAURAY REAL(KIND=JPHOOK) :: ZHOOK_HANDLE @@ -120,14 +129,14 @@ SUBROUTINE SRTM_TAUMOL28 & ENDDO ENDDO -I_LAYSOLFR(:) = I_NLAYERS +I_LAYSOLFR = I_NLAYERS DO I_LAY = 1, I_NLAYERS DO IPLON = KIDIA, KFDIA IF (PRMU0(IPLON) > 0.0_JPRB) THEN IF (I_LAY >= K_LAYTROP(IPLON)+1) THEN IF (K_JP(IPLON,I_LAY-1) < LAYREFFR .AND. K_JP(IPLON,I_LAY) >= LAYREFFR) & - & I_LAYSOLFR(IPLON) = I_LAY + & I_LAYSOLFR = I_LAY Z_SPECCOMB = P_COLO3(IPLON,I_LAY) + STRRAT*P_COLO2(IPLON,I_LAY) Z_SPECPARM = P_COLO3(IPLON,I_LAY)/Z_SPECCOMB IF (Z_SPECPARM >= P_ONEMINUS(IPLON)) Z_SPECPARM = P_ONEMINUS(IPLON) @@ -170,13 +179,8 @@ SUBROUTINE SRTM_TAUMOL28 & & ) ! & + TAURAY ! SSA(LAY,IG) = TAURAY/TAUG(LAY,IG) - IF (I_LAY == I_LAYSOLFR(IPLON)) P_SFLUXZEN(IPLON,IG) = SFLUXREFC(IG,JS) & + IF (I_LAY == I_LAYSOLFR) P_SFLUXZEN(IPLON,IG) = SFLUXREFC(IG,JS) & & + Z_FS * (SFLUXREFC(IG,JS+1) - SFLUXREFC(IG,JS)) -! The following actually improves this band by setting the solar -! spectrum at each g point equal to what would be computed if -! molecular oxygen was set to zero. But it is worse overall due to a -! compensating error with the previous band 27. -! IF (I_LAY == I_LAYSOLFR) P_SFLUXZEN(IPLON,IG) = SFLUXREFC(IG,5) P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY ENDDO ENDIF @@ -185,6 +189,6 @@ SUBROUTINE SRTM_TAUMOL28 & ENDDO !----------------------------------------------------------------------- -IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL28',1,ZHOOK_HANDLE) +IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL28',1,ZHOOK_HANDLE) END SUBROUTINE SRTM_TAUMOL28 diff --git a/ifsrrtm/srtm_taumol29.F90 b/ifsrrtm/srtm_taumol29.F90 index 15b0eb8b..5c7c387d 100644 --- a/ifsrrtm/srtm_taumol29.F90 +++ b/ifsrrtm/srtm_taumol29.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SRTM_TAUMOL29 & & ( KIDIA , KFDIA , KLEV,& & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,& @@ -59,9 +68,9 @@ SUBROUTINE SRTM_TAUMOL29 & !- from PROFDATA !- from SELF !-- from FOREIGN -INTEGER(KIND=JPIM) :: IG, IND0, IND1, INDS, INDF, I_LAY, I_LAYSOLFR(KIDIA:KFDIA), I_NLAYERS, IPLON +INTEGER(KIND=JPIM) :: IG, IND0, IND1, INDS, INDF, I_LAY, I_LAYSOLFR, I_NLAYERS, IPLON -REAL(KIND=JPRB) :: & +REAL(KIND=JPRB) ::& & Z_TAURAY REAL(KIND=JPHOOK) :: ZHOOK_HANDLE @@ -107,14 +116,14 @@ SUBROUTINE SRTM_TAUMOL29 & ENDDO ENDDO -I_LAYSOLFR(:) = I_NLAYERS +I_LAYSOLFR = I_NLAYERS DO I_LAY = 1, I_NLAYERS DO IPLON = KIDIA, KFDIA IF (PRMU0(IPLON) > 0.0_JPRB) THEN IF (I_LAY >= K_LAYTROP(IPLON)+1) THEN IF (K_JP(IPLON,I_LAY-1) < LAYREFFR .AND. K_JP(IPLON,I_LAY) >= LAYREFFR) & - & I_LAYSOLFR(IPLON) = I_LAY + & I_LAYSOLFR = I_LAY IND0 = ((K_JP(IPLON,I_LAY)-13)*5+(K_JT(IPLON,I_LAY)-1))*NSPB(29) + 1 IND1 = ((K_JP(IPLON,I_LAY)-12)*5+(K_JT1(IPLON,I_LAY)-1))*NSPB(29) + 1 Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYL @@ -130,7 +139,7 @@ SUBROUTINE SRTM_TAUMOL29 & & + P_COLH2O(IPLON,I_LAY) * ABSH2OC(IG) ! & + TAURAY ! SSA(LAY,IG) = TAURAY/TAUG(LAY,IG) - IF (I_LAY == I_LAYSOLFR(IPLON)) P_SFLUXZEN(IPLON,IG) = SFLUXREFC(IG) + IF (I_LAY == I_LAYSOLFR) P_SFLUXZEN(IPLON,IG) = SFLUXREFC(IG) P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY ENDDO ENDIF @@ -139,6 +148,6 @@ SUBROUTINE SRTM_TAUMOL29 & ENDDO !----------------------------------------------------------------------- -IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL29',1,ZHOOK_HANDLE) +IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL29',1,ZHOOK_HANDLE) END SUBROUTINE SRTM_TAUMOL29 diff --git a/ifsrrtm/surdi.F90 b/ifsrrtm/surdi.F90 index fc94e083..43250084 100644 --- a/ifsrrtm/surdi.F90 +++ b/ifsrrtm/surdi.F90 @@ -1,4 +1,4 @@ -! (C) Copyright 1988- ECMWF. +! (C) Copyright 2003- ECMWF. ! ! This software is licensed under the terms of the Apache Licence Version 2.0 ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. diff --git a/ifsrrtm/surrtab.F90 b/ifsrrtm/surrtab.F90 index 85b4c1ab..11cfa043 100644 --- a/ifsrrtm/surrtab.F90 +++ b/ifsrrtm/surrtab.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SURRTAB ! ----------------------------------------------------------------- diff --git a/ifsrrtm/surrtftr.F90 b/ifsrrtm/surrtftr.F90 index 846217f7..605560b5 100644 --- a/ifsrrtm/surrtftr.F90 +++ b/ifsrrtm/surrtftr.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SURRTFTR ! Adapted from Eli J. Mlawer, Atmospheric & Environmental Research. diff --git a/ifsrrtm/surrtpk.F90 b/ifsrrtm/surrtpk.F90 index 1bd93a0f..22ac1913 100644 --- a/ifsrrtm/surrtpk.F90 +++ b/ifsrrtm/surrtpk.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SURRTPK ! Adapted from Eli J. Mlawer, Atmospheric & Environmental Research. diff --git a/ifsrrtm/surrtrf.F90 b/ifsrrtm/surrtrf.F90 index 8fe8fd4b..4760d84a 100644 --- a/ifsrrtm/surrtrf.F90 +++ b/ifsrrtm/surrtrf.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SURRTRF ! Adapted from Eli J. Mlawer, Atmospheric & Environmental Research. diff --git a/ifsrrtm/susrtm.F90 b/ifsrrtm/susrtm.F90 index fd8174ac..fb707109 100644 --- a/ifsrrtm/susrtm.F90 +++ b/ifsrrtm/susrtm.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! SUBROUTINE SUSRTM ! Adapted from E.J. Mlawer, J. Delamere, Atmospheric & Environmental Research. diff --git a/ifsrrtm/yoerdi.F90 b/ifsrrtm/yoerdi.F90 index 238f13ba..aba85472 100644 --- a/ifsrrtm/yoerdi.F90 +++ b/ifsrrtm/yoerdi.F90 @@ -1,12 +1,21 @@ +! (C) Copyright 2003- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. + MODULE YOERDI +!$ACDC methods + USE PARKIND1 ,ONLY : JPRB USE YOMHOOK, ONLY : LHOOK, DR_HOOK, JPHOOK IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- diff --git a/ifsrrtm/yoerrta1.F90 b/ifsrrtm/yoerrta1.F90 index 465fbcfd..a0b65aba 100644 --- a/ifsrrtm/yoerrta1.F90 +++ b/ifsrrtm/yoerrta1.F90 @@ -1,11 +1,18 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTA1 USE PARKIND1 ,ONLY : JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- diff --git a/ifsrrtm/yoerrta10.F90 b/ifsrrtm/yoerrta10.F90 index 359b2ffd..d920eac0 100644 --- a/ifsrrtm/yoerrta10.F90 +++ b/ifsrrtm/yoerrta10.F90 @@ -1,11 +1,18 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTA10 USE PARKIND1 ,ONLY : JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- diff --git a/ifsrrtm/yoerrta11.F90 b/ifsrrtm/yoerrta11.F90 index fe1ac797..c20c0f95 100644 --- a/ifsrrtm/yoerrta11.F90 +++ b/ifsrrtm/yoerrta11.F90 @@ -1,11 +1,18 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTA11 USE PARKIND1 ,ONLY : JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- diff --git a/ifsrrtm/yoerrta12.F90 b/ifsrrtm/yoerrta12.F90 index 58bd3d32..fcb1dc02 100644 --- a/ifsrrtm/yoerrta12.F90 +++ b/ifsrrtm/yoerrta12.F90 @@ -1,11 +1,18 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTA12 USE PARKIND1 ,ONLY : JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- diff --git a/ifsrrtm/yoerrta13.F90 b/ifsrrtm/yoerrta13.F90 index 331f021a..80f319a1 100644 --- a/ifsrrtm/yoerrta13.F90 +++ b/ifsrrtm/yoerrta13.F90 @@ -1,11 +1,18 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTA13 USE PARKIND1 ,ONLY : JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- diff --git a/ifsrrtm/yoerrta14.F90 b/ifsrrtm/yoerrta14.F90 index 7da92f7f..a635635f 100644 --- a/ifsrrtm/yoerrta14.F90 +++ b/ifsrrtm/yoerrta14.F90 @@ -1,11 +1,18 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTA14 USE PARKIND1 ,ONLY : JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- diff --git a/ifsrrtm/yoerrta15.F90 b/ifsrrtm/yoerrta15.F90 index 45e20963..f72ab926 100644 --- a/ifsrrtm/yoerrta15.F90 +++ b/ifsrrtm/yoerrta15.F90 @@ -1,11 +1,18 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTA15 USE PARKIND1 ,ONLY : JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- diff --git a/ifsrrtm/yoerrta16.F90 b/ifsrrtm/yoerrta16.F90 index 67d09be4..0697ef0f 100644 --- a/ifsrrtm/yoerrta16.F90 +++ b/ifsrrtm/yoerrta16.F90 @@ -1,11 +1,18 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTA16 USE PARKIND1 ,ONLY : JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- diff --git a/ifsrrtm/yoerrta2.F90 b/ifsrrtm/yoerrta2.F90 index a5df28d4..be15d8d3 100644 --- a/ifsrrtm/yoerrta2.F90 +++ b/ifsrrtm/yoerrta2.F90 @@ -1,11 +1,18 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTA2 USE PARKIND1 ,ONLY : JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- diff --git a/ifsrrtm/yoerrta3.F90 b/ifsrrtm/yoerrta3.F90 index 45816999..bfa9b902 100644 --- a/ifsrrtm/yoerrta3.F90 +++ b/ifsrrtm/yoerrta3.F90 @@ -1,11 +1,18 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTA3 USE PARKIND1 ,ONLY : JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- diff --git a/ifsrrtm/yoerrta4.F90 b/ifsrrtm/yoerrta4.F90 index 1e4b5b4d..b1c432de 100644 --- a/ifsrrtm/yoerrta4.F90 +++ b/ifsrrtm/yoerrta4.F90 @@ -1,11 +1,18 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTA4 USE PARKIND1 ,ONLY : JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- diff --git a/ifsrrtm/yoerrta5.F90 b/ifsrrtm/yoerrta5.F90 index bb466a5c..7e673385 100644 --- a/ifsrrtm/yoerrta5.F90 +++ b/ifsrrtm/yoerrta5.F90 @@ -1,11 +1,18 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTA5 USE PARKIND1 ,ONLY : JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- diff --git a/ifsrrtm/yoerrta6.F90 b/ifsrrtm/yoerrta6.F90 index e096dda2..81e3b51e 100644 --- a/ifsrrtm/yoerrta6.F90 +++ b/ifsrrtm/yoerrta6.F90 @@ -1,11 +1,18 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTA6 USE PARKIND1 ,ONLY : JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- diff --git a/ifsrrtm/yoerrta7.F90 b/ifsrrtm/yoerrta7.F90 index 2527e495..a600475b 100644 --- a/ifsrrtm/yoerrta7.F90 +++ b/ifsrrtm/yoerrta7.F90 @@ -1,11 +1,18 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTA7 USE PARKIND1 ,ONLY : JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- diff --git a/ifsrrtm/yoerrta8.F90 b/ifsrrtm/yoerrta8.F90 index 3883d41e..968b1d4b 100644 --- a/ifsrrtm/yoerrta8.F90 +++ b/ifsrrtm/yoerrta8.F90 @@ -1,11 +1,18 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTA8 USE PARKIND1 ,ONLY : JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- diff --git a/ifsrrtm/yoerrta9.F90 b/ifsrrtm/yoerrta9.F90 index 6c52ac19..dfccfd23 100644 --- a/ifsrrtm/yoerrta9.F90 +++ b/ifsrrtm/yoerrta9.F90 @@ -1,11 +1,18 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTA9 USE PARKIND1 ,ONLY : JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- diff --git a/ifsrrtm/yoerrtab.F90 b/ifsrrtm/yoerrtab.F90 index 798e81fd..e3071eb0 100644 --- a/ifsrrtm/yoerrtab.F90 +++ b/ifsrrtm/yoerrtab.F90 @@ -1,11 +1,18 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTAB USE PARKIND1 ,ONLY : JPRB IMPLICIT NONE -PUBLIC - SAVE ! ------------------------------------------------------------------- diff --git a/ifsrrtm/yoerrtbg2.F90 b/ifsrrtm/yoerrtbg2.F90 index 5a3a094c..0eeb0dfa 100644 --- a/ifsrrtm/yoerrtbg2.F90 +++ b/ifsrrtm/yoerrtbg2.F90 @@ -1,11 +1,18 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTBG2 USE PARKIND1 ,ONLY : JPRB IMPLICIT NONE -PUBLIC - SAVE ! ------------------------------------------------------------------- diff --git a/ifsrrtm/yoerrtftr.F90 b/ifsrrtm/yoerrtftr.F90 index d97a8060..85fff166 100644 --- a/ifsrrtm/yoerrtftr.F90 +++ b/ifsrrtm/yoerrtftr.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTFTR USE PARKIND1 ,ONLY : JPIM ,JPRB @@ -7,8 +16,6 @@ MODULE YOERRTFTR IMPLICIT NONE -PUBLIC - SAVE ! ------------------------------------------------------------------- diff --git a/ifsrrtm/yoerrtm.F90 b/ifsrrtm/yoerrtm.F90 index 6d4e14fd..b4619933 100644 --- a/ifsrrtm/yoerrtm.F90 +++ b/ifsrrtm/yoerrtm.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTM USE PARKIND1 ,ONLY : JPIM @@ -5,8 +14,6 @@ MODULE YOERRTM IMPLICIT NONE -PUBLIC - SAVE ! ------------------------------------------------------------------ diff --git a/ifsrrtm/yoerrto1.F90 b/ifsrrtm/yoerrto1.F90 index 58b764ba..339d36c8 100644 --- a/ifsrrtm/yoerrto1.F90 +++ b/ifsrrtm/yoerrto1.F90 @@ -1,11 +1,18 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTO1 -USE PARKIND1 ,ONLY : JPIM ,JPRB, JPRD +USE PARKIND1 ,ONLY : JPRD, JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- diff --git a/ifsrrtm/yoerrto10.F90 b/ifsrrtm/yoerrto10.F90 index dec86e09..a61b09f7 100644 --- a/ifsrrtm/yoerrto10.F90 +++ b/ifsrrtm/yoerrto10.F90 @@ -1,17 +1,25 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTO10 -USE PARKIND1 ,ONLY : JPIM ,JPRB, JPRD +USE PARKIND1 ,ONLY : JPRD, JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- !* ** *YOERRTO14* - RRTM ORIGINAL COEFFICIENTS FOR INTERVAL 10 ! BAND 10: 1390-1480 cm-1 (low - H2O; high - H2O) ! ABozzo 201306 updated to rrtmg v4.85 +! F. Vana 05-Mar-2015 Support for single precision ! ----------------------------------------------------------------- INTEGER(KIND=JPIM), PARAMETER :: NO10 = 16 diff --git a/ifsrrtm/yoerrto11.F90 b/ifsrrtm/yoerrto11.F90 index 94f4ef15..7fe0d097 100644 --- a/ifsrrtm/yoerrto11.F90 +++ b/ifsrrtm/yoerrto11.F90 @@ -1,17 +1,25 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTO11 -USE PARKIND1 ,ONLY : JPIM ,JPRB, JPRD +USE PARKIND1 ,ONLY : JPRD, JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- !* ** *YOERRTO11* - RRTM ORIGINAL COEFFICIENTS FOR INTERVAL 11 ! BAND 11: 1480-1800 cm-1 (low - H2O; high - H2O) ! ABozzo 201306 updated to rrtmg v4.85 +! F. Vana 05-Mar-2015 Support for single precision ! ----------------------------------------------------------------- INTEGER(KIND=JPIM), PARAMETER :: NO11 = 16 diff --git a/ifsrrtm/yoerrto12.F90 b/ifsrrtm/yoerrto12.F90 index c351c982..a0f597a4 100644 --- a/ifsrrtm/yoerrto12.F90 +++ b/ifsrrtm/yoerrto12.F90 @@ -1,17 +1,25 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTO12 -USE PARKIND1 ,ONLY : JPIM ,JPRB, JPRD +USE PARKIND1 ,ONLY : JPRD, JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- !* ** *YOERRTO12* - RRTM ORIGINAL COEFFICIENTS FOR INTERVAL 12 ! BAND 12: 1800-2080 cm-1 (low - H2O,CO2; high - nothing) ! ABozzo 201306 updated to rrtmg v4.85 +! F. Vana 05-Mar-2015 Support for single precision ! ----------------------------------------------------------------- INTEGER(KIND=JPIM), PARAMETER :: NO12 = 16 diff --git a/ifsrrtm/yoerrto13.F90 b/ifsrrtm/yoerrto13.F90 index fe6b430d..cebcca93 100644 --- a/ifsrrtm/yoerrto13.F90 +++ b/ifsrrtm/yoerrto13.F90 @@ -1,17 +1,25 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTO13 -USE PARKIND1 ,ONLY : JPIM ,JPRB, JPRD +USE PARKIND1 ,ONLY : JPRD, JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- !* ** *YOERRTO13* - RRTM ORIGINAL COEFFICIENTS FOR INTERVAL 13 ! BAND 13: 2080-2250 cm-1 (low - H2O,N2O; high - nothing) ! ABozzo 201306 updated to rrtmg v4.85 +! F. Vana 05-Mar-2015 Support for single precision ! ----------------------------------------------------------------- INTEGER(KIND=JPIM), PARAMETER :: NO13 = 16 diff --git a/ifsrrtm/yoerrto14.F90 b/ifsrrtm/yoerrto14.F90 index 5ccc0a16..5c234430 100644 --- a/ifsrrtm/yoerrto14.F90 +++ b/ifsrrtm/yoerrto14.F90 @@ -1,17 +1,25 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTO14 -USE PARKIND1 ,ONLY : JPIM ,JPRB, JPRD +USE PARKIND1 ,ONLY : JPRD, JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- !* ** *YOERRTO14* - RRTM ORIGINAL COEFFICIENTS FOR INTERVAL 14 ! BAND 14: 2250-2380 cm-1 (low - CO2; high - CO2) ! ABozzo 201306 updated to rrtmg v4.85 +! F. Vana 05-Mar-2015 Support for single precision ! ----------------------------------------------------------------- INTEGER(KIND=JPIM), PARAMETER :: NO14 = 16 diff --git a/ifsrrtm/yoerrto15.F90 b/ifsrrtm/yoerrto15.F90 index 277e1d16..33f1161b 100644 --- a/ifsrrtm/yoerrto15.F90 +++ b/ifsrrtm/yoerrto15.F90 @@ -1,11 +1,18 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTO15 -USE PARKIND1 ,ONLY : JPIM ,JPRB,JPRD +USE PARKIND1 ,ONLY : JPRD, JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- @@ -14,6 +21,7 @@ MODULE YOERRTO15 ! ABozzo 2001306 updated to rrtmg v4.85 ! band 15: 2380-2600 cm-1 (low - n2o,co2; low minor - n2) ! (high - nothing) +! F. Vana 05-Mar-2015 Support for single precision ! ----------------------------------------------------------------- INTEGER(KIND=JPIM), PARAMETER :: NO15 = 16 diff --git a/ifsrrtm/yoerrto16.F90 b/ifsrrtm/yoerrto16.F90 index b491f2ad..9a556478 100644 --- a/ifsrrtm/yoerrto16.F90 +++ b/ifsrrtm/yoerrto16.F90 @@ -1,11 +1,18 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTO16 -USE PARKIND1 ,ONLY : JPIM ,JPRB, JPRD +USE PARKIND1 ,ONLY : JPRD, JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- @@ -13,6 +20,7 @@ MODULE YOERRTO16 ! BAND 16: 2600-3000 cm-1 (low - H2O,CH4; high - nothing) ! ABozzo 201306 updated to rrtmg v4.85 ! band 16: 2600-3250 cm-1 (low key- h2o,ch4; high key - ch4) +! F. Vana 05-Mar-2015 Support for single precision ! ----------------------------------------------------------------- INTEGER(KIND=JPIM), PARAMETER :: NO16 = 16 diff --git a/ifsrrtm/yoerrto2.F90 b/ifsrrtm/yoerrto2.F90 index 76148d5a..9c2ecfce 100644 --- a/ifsrrtm/yoerrto2.F90 +++ b/ifsrrtm/yoerrto2.F90 @@ -1,11 +1,18 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTO2 -USE PARKIND1 ,ONLY : JPIM ,JPRB, JPRD +USE PARKIND1 ,ONLY : JPRD, JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- @@ -13,6 +20,7 @@ MODULE YOERRTO2 ! BAND 2: 250-500 cm-1 (low - H2O; high - H2O) ! ABozzo May 2013 updated to rrtmg v4.85 ! band 2: 350-500 cm-1 (low key - h2o; high key - h2o) +! F. Vana 05-Mar-2015 Support for single precision ! ----------------------------------------------------------------- INTEGER(KIND=JPIM), PARAMETER :: NO2 = 16 diff --git a/ifsrrtm/yoerrto3.F90 b/ifsrrtm/yoerrto3.F90 index 9371b29c..32b28cfe 100644 --- a/ifsrrtm/yoerrto3.F90 +++ b/ifsrrtm/yoerrto3.F90 @@ -1,11 +1,18 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTO3 -USE PARKIND1 ,ONLY : JPIM ,JPRB,JPRD +USE PARKIND1 ,ONLY : JPRD, JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- @@ -14,6 +21,7 @@ MODULE YOERRTO3 ! ABozzo 200130517 updated to rrtmg_lw_v4.85: ! band 3: 500-630 cm-1 (low key - h2o,co2; low minor - n2o) ! (high key - h2o,co2; high minor - n2o) +! F. Vana 05-Mar-2015 Support for single precision ! ----------------------------------------------------------------- INTEGER(KIND=JPIM), PARAMETER :: NO3 = 16 diff --git a/ifsrrtm/yoerrto4.F90 b/ifsrrtm/yoerrto4.F90 index da788048..e13911a1 100644 --- a/ifsrrtm/yoerrto4.F90 +++ b/ifsrrtm/yoerrto4.F90 @@ -1,17 +1,25 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTO4 -USE PARKIND1 ,ONLY : JPIM ,JPRB,JPRD +USE PARKIND1 ,ONLY : JPRD, JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- !* ** *YOERRTO4* - RRTM ORIGINAL COEFFICIENTS FOR INTERVAL 4 ! BAND 4: 630-700 cm-1 (low - H2O,CO2; high - O3,CO2) ! 201306 ABozzo updated to rrtmg v4.85 +! F. Vana 05-Mar-2015 Support for single precision ! ----------------------------------------------------------------- INTEGER(KIND=JPIM), PARAMETER :: NO4 = 16 diff --git a/ifsrrtm/yoerrto5.F90 b/ifsrrtm/yoerrto5.F90 index 421f70a8..dc596d96 100644 --- a/ifsrrtm/yoerrto5.F90 +++ b/ifsrrtm/yoerrto5.F90 @@ -1,17 +1,25 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTO5 -USE PARKIND1 ,ONLY : JPIM ,JPRB,JPRD +USE PARKIND1 ,ONLY : JPRD, JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- !* ** *YOERRTO5* - RRTM ORIGINAL COEFFICIENTS FOR INTERVAL 5 ! BAND 5: 700-820 cm-1 (low - H2O,CO2; high - O3,CO2) ! ABozzo 201306 updated to rrtmg v4.85 +! F. Vana 05-Mar-2015 Support for single precision ! ----------------------------------------------------------------- INTEGER(KIND=JPIM), PARAMETER :: NO5 = 16 diff --git a/ifsrrtm/yoerrto6.F90 b/ifsrrtm/yoerrto6.F90 index 97d01ad1..03fcd853 100644 --- a/ifsrrtm/yoerrto6.F90 +++ b/ifsrrtm/yoerrto6.F90 @@ -1,17 +1,25 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTO6 -USE PARKIND1 ,ONLY : JPIM ,JPRB, JPRD +USE PARKIND1 ,ONLY : JPRD, JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- !* ** *YOERRTO6* - RRTM ORIGINAL COEFFICIENTS FOR INTERVAL 6 ! BAND 6: 820-980 cm-1 (low - H2O; high - nothing) ! ABozzo 201306 update to rrtmg v4.85 +! F. Vana 05-Mar-2015 Support for single precision ! ----------------------------------------------------------------- INTEGER(KIND=JPIM), PARAMETER :: NO6 = 16 diff --git a/ifsrrtm/yoerrto7.F90 b/ifsrrtm/yoerrto7.F90 index 44e62775..d6aa6a94 100644 --- a/ifsrrtm/yoerrto7.F90 +++ b/ifsrrtm/yoerrto7.F90 @@ -1,17 +1,25 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTO7 -USE PARKIND1 ,ONLY : JPIM ,JPRB,JPRD +USE PARKIND1 ,ONLY : JPRD, JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- !* ** *YOERRTO7* - RRTM ORIGINAL COEFFICIENTS FOR INTERVAL 7 ! BAND 7: 980-1080 cm-1 (low - H2O,O3; high - O3) ! ABozzo updated to rrtmg v4.85 +! F. Vana 05-Mar-2015 Support for single precision ! ----------------------------------------------------------------- INTEGER(KIND=JPIM), PARAMETER :: NO7 = 16 diff --git a/ifsrrtm/yoerrto8.F90 b/ifsrrtm/yoerrto8.F90 index 53ecd018..0feed261 100644 --- a/ifsrrtm/yoerrto8.F90 +++ b/ifsrrtm/yoerrto8.F90 @@ -1,17 +1,25 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTO8 -USE PARKIND1 ,ONLY : JPIM ,JPRB,JPRD +USE PARKIND1 ,ONLY : JPRD, JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- !* ** *YOERRTO8* - RRTM ORIGINAL COEFFICIENTS FOR INTERVAL 8 ! BAND 8: 1080-1180 cm-1 (low (i.e.>~300mb) - H2O; high - O3) ! ABozzo 201306 updated to rrtmg v4.85 +! F. Vana 05-Mar-2015 Support for single precision ! ----------------------------------------------------------------- INTEGER(KIND=JPIM), PARAMETER :: NO8 = 16 diff --git a/ifsrrtm/yoerrto9.F90 b/ifsrrtm/yoerrto9.F90 index f70b6056..d94b35c6 100644 --- a/ifsrrtm/yoerrto9.F90 +++ b/ifsrrtm/yoerrto9.F90 @@ -1,17 +1,25 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTO9 -USE PARKIND1 ,ONLY : JPIM ,JPRB,JPRD +USE PARKIND1 ,ONLY : JPRD, JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- !* ** *YOERRTO9* - RRTM ORIGINAL COEFFICIENTS FOR INTERVAL 9 ! BAND 9: 1180-1390 cm-1 (low - H2O,CH4; high - CH4) ! ABozzo 201306 updated to rrtmg v4.85 +! F. Vana 05-Mar-2015 Support for single precision ! ----------------------------------------------------------------- INTEGER(KIND=JPIM), PARAMETER :: NO9 = 16 diff --git a/ifsrrtm/yoerrtrf.F90 b/ifsrrtm/yoerrtrf.F90 index 28008a22..f2668bcd 100644 --- a/ifsrrtm/yoerrtrf.F90 +++ b/ifsrrtm/yoerrtrf.F90 @@ -1,11 +1,18 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTRF USE PARKIND1 ,ONLY : JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- diff --git a/ifsrrtm/yoerrtrwt.F90 b/ifsrrtm/yoerrtrwt.F90 index a5ecc4b6..63f9fb30 100644 --- a/ifsrrtm/yoerrtrwt.F90 +++ b/ifsrrtm/yoerrtrwt.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTRWT USE PARKIND1, ONLY : JPRB @@ -6,8 +15,6 @@ MODULE YOERRTRWT IMPLICIT NONE -PUBLIC - SAVE ! ------------------------------------------------------------------- diff --git a/ifsrrtm/yoerrtwn.F90 b/ifsrrtm/yoerrtwn.F90 index d0453892..f1a1f47b 100644 --- a/ifsrrtm/yoerrtwn.F90 +++ b/ifsrrtm/yoerrtwn.F90 @@ -1,11 +1,18 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOERRTWN USE PARKIND1 ,ONLY : JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ------------------------------------------------------------------- diff --git a/ifsrrtm/yoesrta16.F90 b/ifsrrtm/yoesrta16.F90 index 89a7cf00..26af0b18 100644 --- a/ifsrrtm/yoesrta16.F90 +++ b/ifsrrtm/yoesrta16.F90 @@ -1,16 +1,24 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOESRTA16 -USE PARKIND1 ,ONLY : JPIM ,JPRB,JPRD +USE PARKIND1 ,ONLY : JPRD, JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- !* ** *YOESRTA16* - SRTM COEFFICIENTS FOR INTERVAL 16 ! BAND 16: 2600-3250 cm-1 (low - H2O,CH4; high - CH4) +! F. Vana 05-Mar-2015 Support for single precision ! ----------------------------------------------------------------- INTEGER(KIND=JPIM), PARAMETER :: JPG=16, NG16 = 16, NGS15 = 0 diff --git a/ifsrrtm/yoesrta17.F90 b/ifsrrtm/yoesrta17.F90 index c0a62775..1b81deb2 100644 --- a/ifsrrtm/yoesrta17.F90 +++ b/ifsrrtm/yoesrta17.F90 @@ -1,16 +1,24 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOESRTA17 -USE PARKIND1 ,ONLY : JPIM ,JPRB,JPRD +USE PARKIND1 ,ONLY : JPRD, JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- !* ** *YOESRTA17* - SRTM COEFFICIENTS FOR INTERVAL 17 ! BAND 17: 3250-4000 cm-1 (low - H2O,CO2; high - H2O,CO2) +! F. Vana 05-Mar-2015 Support for single precision ! ----------------------------------------------------------------- INTEGER(KIND=JPIM), PARAMETER :: JPG = 16, NG17 = 16, NGS16=16 diff --git a/ifsrrtm/yoesrta18.F90 b/ifsrrtm/yoesrta18.F90 index cfdcee5b..56f2d90c 100644 --- a/ifsrrtm/yoesrta18.F90 +++ b/ifsrrtm/yoesrta18.F90 @@ -1,16 +1,24 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOESRTA18 -USE PARKIND1 ,ONLY : JPIM ,JPRB,JPRD +USE PARKIND1 ,ONLY : JPRD, JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- !* ** *YOESRTA18* - SRTM COEFFICIENTS FOR INTERVAL 16 ! BAND 18: 4000-4650 cm-1 (low - H2O,CH4; high - CH4) +! F. Vana 05-Mar-2015 Support for single precision ! ----------------------------------------------------------------- INTEGER(KIND=JPIM), PARAMETER :: JPG = 16, NG18 = 16, NGS17=32 diff --git a/ifsrrtm/yoesrta19.F90 b/ifsrrtm/yoesrta19.F90 index 59af1247..bdf2b717 100644 --- a/ifsrrtm/yoesrta19.F90 +++ b/ifsrrtm/yoesrta19.F90 @@ -1,16 +1,24 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOESRTA19 -USE PARKIND1 ,ONLY : JPIM ,JPRB,JPRD +USE PARKIND1 ,ONLY : JPRD, JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- !* ** *YOESRTA19* - SRTM COEFFICIENTS FOR INTERVAL 19 ! BAND 19: 4650-5150 cm-1 (low - H2O,CO2; high - CO2) +! F. Vana 05-Mar-2015 Support for single precision ! ----------------------------------------------------------------- INTEGER(KIND=JPIM), PARAMETER :: JPG = 16, NG19 = 16 diff --git a/ifsrrtm/yoesrta20.F90 b/ifsrrtm/yoesrta20.F90 index 93fe80d2..dcda0ebe 100644 --- a/ifsrrtm/yoesrta20.F90 +++ b/ifsrrtm/yoesrta20.F90 @@ -1,16 +1,24 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOESRTA20 -USE PARKIND1 ,ONLY : JPIM ,JPRB,JPRD +USE PARKIND1 ,ONLY : JPRD, JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- !* ** *YOESRTA20* - SRTM COEFFICIENTS FOR INTERVAL 20 ! BAND 20: 5150-6150 cm-1 (low - H2O; high - H2O) +! F. Vana 05-Mar-2015 Support for single precision ! ----------------------------------------------------------------- INTEGER(KIND=JPIM), PARAMETER :: JPG = 16, NG20 = 16 diff --git a/ifsrrtm/yoesrta21.F90 b/ifsrrtm/yoesrta21.F90 index 1c529b80..2f6a3a43 100644 --- a/ifsrrtm/yoesrta21.F90 +++ b/ifsrrtm/yoesrta21.F90 @@ -1,16 +1,25 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOESRTA21 -USE PARKIND1 ,ONLY : JPIM ,JPRB,JPRD +USE PARKIND1 ,ONLY : JPRD, JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- !* ** *YOESRTA21* - SRTM COEFFICIENTS FOR INTERVAL 21 ! BAND 21: 6150-7700 cm-1 (low - H2O,CO2; high - H2O,CO2) +! F. Vana 05-Mar-2015 Support for single precision +! R. Hogan 15-Jul-2015 Bug fix: use 2nd EQUIVALENCE statement for RRTM*G* ! ----------------------------------------------------------------- INTEGER(KIND=JPIM), PARAMETER :: JPG = 16, NG21 = 16 @@ -29,6 +38,8 @@ MODULE YOESRTA21 REAL(KIND=JPRB) :: SELFREFC(10,NG21) ,FORREFC(4,NG21) REAL(KIND=JPRB) :: SFLUXREFC(NG21,9) +! The second one selects the reduced number of gridpoints - to select +! the first without changing other parts of the IFS is an error !EQUIVALENCE (KA(1,1,1,1),ABSA(1,1)), (KB(1,1,13,1),ABSB(1,1)) EQUIVALENCE (KAC(1,1,1,1),ABSA(1,1)), (KBC(1,1,13,1),ABSB(1,1)) diff --git a/ifsrrtm/yoesrta22.F90 b/ifsrrtm/yoesrta22.F90 index 2a65b554..76f53e28 100644 --- a/ifsrrtm/yoesrta22.F90 +++ b/ifsrrtm/yoesrta22.F90 @@ -1,16 +1,24 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOESRTA22 -USE PARKIND1 ,ONLY : JPIM ,JPRB,JPRD +USE PARKIND1 ,ONLY : JPRD, JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- !* ** *YOESRTA22* - SRTM COEFFICIENTS FOR INTERVAL 22 ! BAND 22: 7700-8050 cm-1 (low - H2O,O2; high - O2) +! F. Vana 05-Mar-2015 Support for single precision ! ----------------------------------------------------------------- INTEGER(KIND=JPIM), PARAMETER :: JPG = 16, NG22 = 16 diff --git a/ifsrrtm/yoesrta23.F90 b/ifsrrtm/yoesrta23.F90 index b58e030c..d617da14 100644 --- a/ifsrrtm/yoesrta23.F90 +++ b/ifsrrtm/yoesrta23.F90 @@ -1,16 +1,24 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOESRTA23 -USE PARKIND1 ,ONLY : JPIM ,JPRB,JPRD +USE PARKIND1 ,ONLY : JPRD, JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- !* ** *YOESRTA23* - SRTM COEFFICIENTS FOR INTERVAL 23 ! BAND 23: 8050-12850 cm-1 (low - H2O; high - nothing) +! F. Vana 05-Mar-2015 Support for single precision ! ----------------------------------------------------------------- INTEGER(KIND=JPIM), PARAMETER :: JPG = 16, NG23 = 16 diff --git a/ifsrrtm/yoesrta24.F90 b/ifsrrtm/yoesrta24.F90 index 7418d603..f9a4aeb3 100644 --- a/ifsrrtm/yoesrta24.F90 +++ b/ifsrrtm/yoesrta24.F90 @@ -1,16 +1,24 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOESRTA24 -USE PARKIND1 ,ONLY : JPIM ,JPRB,JPRD +USE PARKIND1 ,ONLY : JPRD, JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- !* ** *YOESRTA24* - SRTM COEFFICIENTS FOR INTERVAL 24 ! BAND 24: 12850-16000 cm-1 (low - H2O,O2; high - O2) +! F. Vana 05-Mar-2015 Support for single precision ! ----------------------------------------------------------------- INTEGER(KIND=JPIM), PARAMETER :: JPG = 16, NG24 = 16 diff --git a/ifsrrtm/yoesrta25.F90 b/ifsrrtm/yoesrta25.F90 index c7002473..227eacb8 100644 --- a/ifsrrtm/yoesrta25.F90 +++ b/ifsrrtm/yoesrta25.F90 @@ -1,16 +1,24 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOESRTA25 -USE PARKIND1 ,ONLY : JPIM ,JPRB,JPRD +USE PARKIND1 ,ONLY : JPRD, JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- !* ** *YOESRTA25* - SRTM COEFFICIENTS FOR INTERVAL 25 ! BAND 25: 16000-22650 cm-1 (low - H2O; high - nothing) +! F. Vana 05-Mar-2015 Support for single precision ! ----------------------------------------------------------------- INTEGER(KIND=JPIM), PARAMETER :: JPG = 16, NG25 = 16 diff --git a/ifsrrtm/yoesrta26.F90 b/ifsrrtm/yoesrta26.F90 index 02bb0d3c..43e06615 100644 --- a/ifsrrtm/yoesrta26.F90 +++ b/ifsrrtm/yoesrta26.F90 @@ -1,11 +1,18 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOESRTA26 USE PARKIND1 ,ONLY : JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- diff --git a/ifsrrtm/yoesrta27.F90 b/ifsrrtm/yoesrta27.F90 index e0fd1975..61b3876d 100644 --- a/ifsrrtm/yoesrta27.F90 +++ b/ifsrrtm/yoesrta27.F90 @@ -1,16 +1,24 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOESRTA27 -USE PARKIND1 ,ONLY : JPIM ,JPRB,JPRD +USE PARKIND1 ,ONLY : JPRD, JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- !* ** *YOESRTA27* - SRTM COEFFICIENTS FOR INTERVAL 27 ! BAND 27: 29000-38000 cm-1 (low - O3; high - O3) +! F. Vana 05-Mar-2015 Support for single precision ! ----------------------------------------------------------------- INTEGER(KIND=JPIM), PARAMETER :: JPG = 16, NG27 = 16 diff --git a/ifsrrtm/yoesrta28.F90 b/ifsrrtm/yoesrta28.F90 index 77b452e6..9e1cebcc 100644 --- a/ifsrrtm/yoesrta28.F90 +++ b/ifsrrtm/yoesrta28.F90 @@ -1,16 +1,24 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOESRTA28 -USE PARKIND1 ,ONLY : JPIM ,JPRB,JPRD +USE PARKIND1 ,ONLY : JPRD, JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- !* ** *YOESRTA28* - SRTM COEFFICIENTS FOR INTERVAL 28 ! BAND 28: 38000-50000 cm-1 (low - O3, O2; high - O3, O2) +! F. Vana 05-Mar-2015 Support for single precision ! ----------------------------------------------------------------- INTEGER(KIND=JPIM), PARAMETER :: JPG = 16, NG28 = 16 diff --git a/ifsrrtm/yoesrta29.F90 b/ifsrrtm/yoesrta29.F90 index 71f87e90..7ac0002e 100644 --- a/ifsrrtm/yoesrta29.F90 +++ b/ifsrrtm/yoesrta29.F90 @@ -1,16 +1,24 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOESRTA29 -USE PARKIND1 ,ONLY : JPIM ,JPRB,JPRD +USE PARKIND1 ,ONLY : JPRD, JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ----------------------------------------------------------------- !* ** *YOESRTA29* - SRTM COEFFICIENTS FOR INTERVAL 29 ! BAND 29: 820-2600 cm-1 (low - H2O; high - CO2) +! F. Vana 05-Mar-2015 Support for single precision ! ----------------------------------------------------------------- INTEGER(KIND=JPIM), PARAMETER :: JPG = 16, NG29 = 16 diff --git a/ifsrrtm/yoesrtab.F90 b/ifsrrtm/yoesrtab.F90 index 7eb5b7e7..bb6c6db1 100644 --- a/ifsrrtm/yoesrtab.F90 +++ b/ifsrrtm/yoesrtab.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOESRTAB USE PARKIND1 ,ONLY : JPRB diff --git a/ifsrrtm/yoesrtaer.F90 b/ifsrrtm/yoesrtaer.F90 index abe6d4f6..8b29c3b4 100644 --- a/ifsrrtm/yoesrtaer.F90 +++ b/ifsrrtm/yoesrtaer.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOESRTAER USE PARKIND1 ,ONLY : JPRB diff --git a/ifsrrtm/yoesrtm.F90 b/ifsrrtm/yoesrtm.F90 index a24933f4..d540c674 100644 --- a/ifsrrtm/yoesrtm.F90 +++ b/ifsrrtm/yoesrtm.F90 @@ -1,3 +1,12 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOESRTM USE PARKIND1 ,ONLY : JPIM @@ -5,8 +14,6 @@ MODULE YOESRTM IMPLICIT NONE -PUBLIC - SAVE ! ------------------------------------------------------------------ diff --git a/ifsrrtm/yoesrtwn.F90 b/ifsrrtm/yoesrtwn.F90 index 130be033..a9706c75 100644 --- a/ifsrrtm/yoesrtwn.F90 +++ b/ifsrrtm/yoesrtwn.F90 @@ -1,11 +1,18 @@ +! (C) Copyright 2005- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! MODULE YOESRTWN USE PARKIND1 ,ONLY : JPIM ,JPRB IMPLICIT NONE -PUBLIC - SAVE ! ------------------------------------------------------------------- diff --git a/ifsrrtm/yoesw.F90 b/ifsrrtm/yoesw.F90 index da66355a..f933c693 100644 --- a/ifsrrtm/yoesw.F90 +++ b/ifsrrtm/yoesw.F90 @@ -1,5 +1,16 @@ +! (C) Copyright 2003- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. + MODULE YOESW +!$ACDC methods + USE PARKIND1 ,ONLY : JPIM ,JPRB IMPLICIT NONE diff --git a/radiation/radiation_aerosol_optics.F90 b/radiation/radiation_aerosol_optics.F90 index a705fb37..7edee627 100644 --- a/radiation/radiation_aerosol_optics.F90 +++ b/radiation/radiation_aerosol_optics.F90 @@ -18,8 +18,6 @@ ! 2022-03-27 R. Hogan Add setup_general_aerosol_optics_legacy to use RRTM aerosol files with ecCKD ! 2022-11-22 P. Ukkonen / R. Hogan Optimizations to enhance vectorization -#include "ecrad_config.h" - module radiation_aerosol_optics implicit none @@ -97,11 +95,7 @@ subroutine setup_general_aerosol_optics(config) use parkind1, only : jprb use yomhook, only : lhook, dr_hook, jphook -#ifdef EASY_NETCDF_READ_MPI use easy_netcdf_read_mpi, only : netcdf_file -#else - use easy_netcdf, only : netcdf_file -#endif use radiation_config, only : config_type use radiation_aerosol_optics_data, only : aerosol_optics_type use radiation_spectral_definition, only : SolarReferenceTemperature, & @@ -132,6 +126,9 @@ subroutine setup_general_aerosol_optics(config) ! the file, and spectral intervals used by the gas-optics scheme real(jprb), allocatable :: mapping(:,:) + ! Pointer to the aerosol optics coefficients for brevity of access + type(aerosol_optics_type), pointer :: ao + ! Target monochromatic wavenumber for interpolation (cm-1) real(jprb) :: wavenumber_target @@ -152,186 +149,184 @@ subroutine setup_general_aerosol_optics(config) if (lhook) call dr_hook('radiation_aerosol_optics:setup_general_aerosol_optics',0,hook_handle) - associate(ao => config%aerosol_optics) + ao => config%aerosol_optics - call file%open(trim(config%aerosol_optics_file_name), iverbose=config%iverbosesetup) + call file%open(trim(config%aerosol_optics_file_name), iverbose=config%iverbosesetup) - if (.not. file%exists('wavenumber')) then - ! Assume we have an old-style aerosol optics file with optical - ! properties provided per pre-defined band - call file%close() - if (config%iverbosesetup >= 2) then - write(nulout,'(a)') 'Legacy aerosol optics file: mapping between bands' - end if - call setup_general_aerosol_optics_legacy(config, trim(config%aerosol_optics_file_name)) - if (lhook) call dr_hook('radiation_aerosol_optics:setup_general_aerosol_optics',1,hook_handle) - return - end if - - if (file%exists('mass_ext_hydrophilic')) then - ao%use_hydrophilic = .true. - else - ao%use_hydrophilic = .false. + if (.not. file%exists('wavenumber')) then + ! Assume we have an old-style aerosol optics file with optical + ! properties provided per pre-defined band + call file%close() + if (config%iverbosesetup >= 2) then + write(nulout,'(a)') 'Legacy aerosol optics file: mapping between bands' end if + call setup_general_aerosol_optics_legacy(config, trim(config%aerosol_optics_file_name)) + if (lhook) call dr_hook('radiation_aerosol_optics:setup_general_aerosol_optics',1,hook_handle) + return + end if - call file%get('wavenumber', wavenumber) - nwn = size(wavenumber) + if (file%exists('mass_ext_hydrophilic')) then + ao%use_hydrophilic = .true. + else + ao%use_hydrophilic = .false. + end if + + call file%get('wavenumber', wavenumber) + nwn = size(wavenumber) - ! Read the raw scattering data - call file%get('mass_ext_hydrophobic', mass_ext_phobic) - call file%get('ssa_hydrophobic', ssa_phobic) - call file%get('asymmetry_hydrophobic', g_phobic) - call file%get('lidar_ratio_hydrophobic', lidar_ratio_phobic) + ! Read the raw scattering data + call file%get('mass_ext_hydrophobic', mass_ext_phobic) + call file%get('ssa_hydrophobic', ssa_phobic) + call file%get('asymmetry_hydrophobic', g_phobic) + call file%get('lidar_ratio_hydrophobic', lidar_ratio_phobic) - call file%get_global_attribute('description_hydrophobic', & - & ao%description_phobic_str) + call file%get_global_attribute('description_hydrophobic', & + & ao%description_phobic_str) - if (ao%use_hydrophilic) then - call file%get('mass_ext_hydrophilic', mass_ext_philic) - call file%get('ssa_hydrophilic', ssa_philic) - call file%get('asymmetry_hydrophilic', g_philic) - call file%get('lidar_ratio_hydrophilic', lidar_ratio_philic) + if (ao%use_hydrophilic) then + call file%get('mass_ext_hydrophilic', mass_ext_philic) + call file%get('ssa_hydrophilic', ssa_philic) + call file%get('asymmetry_hydrophilic', g_philic) + call file%get('lidar_ratio_hydrophilic', lidar_ratio_philic) - call file%get('relative_humidity1', ao%rh_lower) + call file%get('relative_humidity1', ao%rh_lower) - call file%get_global_attribute('description_hydrophilic', & - & ao%description_philic_str) - end if + call file%get_global_attribute('description_hydrophilic', & + & ao%description_philic_str) + end if - ! Close aerosol scattering file - call file%close() + ! Close aerosol scattering file + call file%close() - n_type_phobic = size(mass_ext_phobic, 2) - if (ao%use_hydrophilic) then - n_type_philic = size(mass_ext_philic, 3) - nrh = size(ao%rh_lower) - else - n_type_philic = 0 - nrh = 0 - end if + n_type_phobic = size(mass_ext_phobic, 2) + if (ao%use_hydrophilic) then + n_type_philic = size(mass_ext_philic, 3) + nrh = size(ao%rh_lower) + else + n_type_philic = 0 + nrh = 0 + end if - if (config%do_cloud_aerosol_per_sw_g_point) then - nspecsw = config%gas_optics_sw%spectral_def%ng - else - nspecsw = config%gas_optics_sw%spectral_def%nband - end if + if (config%do_cloud_aerosol_per_sw_g_point) then + nspecsw = config%gas_optics_sw%spectral_def%ng + else + nspecsw = config%gas_optics_sw%spectral_def%nband + end if - if (config%do_cloud_aerosol_per_lw_g_point) then - nspeclw = config%gas_optics_lw%spectral_def%ng - else - nspeclw = config%gas_optics_lw%spectral_def%nband - end if + if (config%do_cloud_aerosol_per_lw_g_point) then + nspeclw = config%gas_optics_lw%spectral_def%ng + else + nspeclw = config%gas_optics_lw%spectral_def%nband + end if - if (allocated(ao%wavelength_mono)) then - ! Monochromatic wavelengths also required - nmono = size(ao%wavelength_mono) - else - nmono = 0 - end if + if (allocated(ao%wavelength_mono)) then + ! Monochromatic wavelengths also required + nmono = size(ao%wavelength_mono) + else + nmono = 0 + end if - call ao%allocate(n_type_phobic, n_type_philic, nrh, nspeclw, nspecsw, nmono) + call ao%allocate(n_type_phobic, n_type_philic, nrh, nspeclw, nspecsw, nmono) - if (config%do_sw) then - call config%gas_optics_sw%spectral_def%calc_mapping(wavenumber, mapping, & - & use_bands=(.not. config%do_cloud_aerosol_per_sw_g_point)) + if (config%do_sw) then + call config%gas_optics_sw%spectral_def%calc_mapping(wavenumber, mapping, & + & use_bands=(.not. config%do_cloud_aerosol_per_sw_g_point)) - ao%mass_ext_sw_phobic = matmul(mapping, mass_ext_phobic) - ao%ssa_sw_phobic = matmul(mapping, mass_ext_phobic*ssa_phobic) & - & / ao%mass_ext_sw_phobic - ao%g_sw_phobic = matmul(mapping, mass_ext_phobic*ssa_phobic*g_phobic) & - & / (ao%mass_ext_sw_phobic*ao%ssa_sw_phobic) + ao%mass_ext_sw_phobic = matmul(mapping, mass_ext_phobic) + ao%ssa_sw_phobic = matmul(mapping, mass_ext_phobic*ssa_phobic) & + & / ao%mass_ext_sw_phobic + ao%g_sw_phobic = matmul(mapping, mass_ext_phobic*ssa_phobic*g_phobic) & + & / (ao%mass_ext_sw_phobic*ao%ssa_sw_phobic) - if (ao%use_hydrophilic) then - do jtype = 1,n_type_philic - ao%mass_ext_sw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype)) - ao%ssa_sw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype) & - & *ssa_philic(:,:,jtype)) & - & / ao%mass_ext_sw_philic(:,:,jtype) - ao%g_sw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype) & - & *ssa_philic(:,:,jtype)*g_philic(:,:,jtype)) & - & / (ao%mass_ext_sw_philic(:,:,jtype)*ao%ssa_sw_philic(:,:,jtype)) - end do - end if + if (ao%use_hydrophilic) then + do jtype = 1,n_type_philic + ao%mass_ext_sw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype)) + ao%ssa_sw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype) & + & *ssa_philic(:,:,jtype)) & + & / ao%mass_ext_sw_philic(:,:,jtype) + ao%g_sw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype) & + & *ssa_philic(:,:,jtype)*g_philic(:,:,jtype)) & + & / (ao%mass_ext_sw_philic(:,:,jtype)*ao%ssa_sw_philic(:,:,jtype)) + end do end if + end if - if (config%do_lw) then - call config%gas_optics_lw%spectral_def%calc_mapping(wavenumber, mapping, & - & use_bands=(.not. config%do_cloud_aerosol_per_lw_g_point)) - - ao%mass_ext_lw_phobic = matmul(mapping, mass_ext_phobic) - ao%ssa_lw_phobic = matmul(mapping, mass_ext_phobic*ssa_phobic) & - & / ao%mass_ext_lw_phobic - ao%g_lw_phobic = matmul(mapping, mass_ext_phobic*ssa_phobic*g_phobic) & - & / (ao%mass_ext_lw_phobic*ao%ssa_lw_phobic) + if (config%do_lw) then + call config%gas_optics_lw%spectral_def%calc_mapping(wavenumber, mapping, & + & use_bands=(.not. config%do_cloud_aerosol_per_lw_g_point)) - if (ao%use_hydrophilic) then - do jtype = 1,n_type_philic - ao%mass_ext_lw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype)) - ao%ssa_lw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype) & - & *ssa_philic(:,:,jtype)) & - & / ao%mass_ext_lw_philic(:,:,jtype) - ao%g_lw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype) & - & *ssa_philic(:,:,jtype)*g_philic(:,:,jtype)) & - & / (ao%mass_ext_lw_philic(:,:,jtype)*ao%ssa_lw_philic(:,:,jtype)) - end do - end if - end if + ao%mass_ext_lw_phobic = matmul(mapping, mass_ext_phobic) + ao%ssa_lw_phobic = matmul(mapping, mass_ext_phobic*ssa_phobic) & + & / ao%mass_ext_lw_phobic + ao%g_lw_phobic = matmul(mapping, mass_ext_phobic*ssa_phobic*g_phobic) & + & / (ao%mass_ext_lw_phobic*ao%ssa_lw_phobic) - if (allocated(ao%wavelength_mono)) then - ! Monochromatic wavelengths also required - do jwl = 1,nmono - ! Wavelength (m) to wavenumber (cm-1) - wavenumber_target = 0.01_jprb / ao%wavelength_mono(jwl) - ! Find index to first interpolation point, and its weight - if (wavenumber_target <= wavenumber(1)) then - weight1 = 1.0_jprb - iwn = 1 - else if (wavenumber_target >= wavenumber(nwn)) then - iwn = nwn-1 - weight1 = 0.0_jprb - else - iwn = 1 - do while (wavenumber(iwn+1) < wavenumber_target .and. iwn < nwn-1) - iwn = iwn + 1 - end do - weight1 = (wavenumber(iwn+1)-wavenumber_target) & - & / (wavenumber(iwn+1)-wavenumber(iwn)) - end if - ! Linear interpolation - ao%mass_ext_mono_phobic(jwl,:) = weight1 * mass_ext_phobic(iwn,:) & - & + (1.0_jprb - weight1)* mass_ext_phobic(iwn+1,:) - ao%ssa_mono_phobic(jwl,:) = weight1 * ssa_phobic(iwn,:) & - & + (1.0_jprb - weight1)* ssa_phobic(iwn+1,:) - ao%g_mono_phobic(jwl,:) = weight1 * g_phobic(iwn,:) & - & + (1.0_jprb - weight1)* g_phobic(iwn+1,:) - ao%lidar_ratio_mono_phobic(jwl,:) = weight1 * lidar_ratio_phobic(iwn,:) & - & + (1.0_jprb - weight1)* lidar_ratio_phobic(iwn+1,:) - if (ao%use_hydrophilic) then - ao%mass_ext_mono_philic(jwl,:,:) = weight1 * mass_ext_philic(iwn,:,:) & - & + (1.0_jprb - weight1)* mass_ext_philic(iwn+1,:,:) - ao%ssa_mono_philic(jwl,:,:) = weight1 * ssa_philic(iwn,:,:) & - & + (1.0_jprb - weight1)* ssa_philic(iwn+1,:,:) - ao%g_mono_philic(jwl,:,:) = weight1 * g_philic(iwn,:,:) & - & + (1.0_jprb - weight1)* g_philic(iwn+1,:,:) - ao%lidar_ratio_mono_philic(jwl,:,:) = weight1 * lidar_ratio_philic(iwn,:,:) & - & + (1.0_jprb - weight1)* lidar_ratio_philic(iwn+1,:,:) - end if + if (ao%use_hydrophilic) then + do jtype = 1,n_type_philic + ao%mass_ext_lw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype)) + ao%ssa_lw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype) & + & *ssa_philic(:,:,jtype)) & + & / ao%mass_ext_lw_philic(:,:,jtype) + ao%g_lw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype) & + & *ssa_philic(:,:,jtype)*g_philic(:,:,jtype)) & + & / (ao%mass_ext_lw_philic(:,:,jtype)*ao%ssa_lw_philic(:,:,jtype)) end do end if + end if - ! Deallocate memory local to this routine - deallocate(mass_ext_phobic) - deallocate(ssa_phobic) - deallocate(g_phobic) - deallocate(lidar_ratio_phobic) - if (ao%use_hydrophilic) then - deallocate(mass_ext_philic) - deallocate(ssa_philic) - deallocate(g_philic) - deallocate(lidar_ratio_philic) - end if + if (allocated(ao%wavelength_mono)) then + ! Monochromatic wavelengths also required + do jwl = 1,nmono + ! Wavelength (m) to wavenumber (cm-1) + wavenumber_target = 0.01_jprb / ao%wavelength_mono(jwl) + ! Find index to first interpolation point, and its weight + if (wavenumber_target <= wavenumber(1)) then + weight1 = 1.0_jprb + iwn = 1 + else if (wavenumber_target >= wavenumber(nwn)) then + iwn = nwn-1 + weight1 = 0.0_jprb + else + iwn = 1 + do while (wavenumber(iwn+1) < wavenumber_target .and. iwn < nwn-1) + iwn = iwn + 1 + end do + weight1 = (wavenumber(iwn+1)-wavenumber_target) & + & / (wavenumber(iwn+1)-wavenumber(iwn)) + end if + ! Linear interpolation + ao%mass_ext_mono_phobic(jwl,:) = weight1 * mass_ext_phobic(iwn,:) & + & + (1.0_jprb - weight1)* mass_ext_phobic(iwn+1,:) + ao%ssa_mono_phobic(jwl,:) = weight1 * ssa_phobic(iwn,:) & + & + (1.0_jprb - weight1)* ssa_phobic(iwn+1,:) + ao%g_mono_phobic(jwl,:) = weight1 * g_phobic(iwn,:) & + & + (1.0_jprb - weight1)* g_phobic(iwn+1,:) + ao%lidar_ratio_mono_phobic(jwl,:) = weight1 * lidar_ratio_phobic(iwn,:) & + & + (1.0_jprb - weight1)* lidar_ratio_phobic(iwn+1,:) + if (ao%use_hydrophilic) then + ao%mass_ext_mono_philic(jwl,:,:) = weight1 * mass_ext_philic(iwn,:,:) & + & + (1.0_jprb - weight1)* mass_ext_philic(iwn+1,:,:) + ao%ssa_mono_philic(jwl,:,:) = weight1 * ssa_philic(iwn,:,:) & + & + (1.0_jprb - weight1)* ssa_philic(iwn+1,:,:) + ao%g_mono_philic(jwl,:,:) = weight1 * g_philic(iwn,:,:) & + & + (1.0_jprb - weight1)* g_philic(iwn+1,:,:) + ao%lidar_ratio_mono_philic(jwl,:,:) = weight1 * lidar_ratio_philic(iwn,:,:) & + & + (1.0_jprb - weight1)* lidar_ratio_philic(iwn+1,:,:) + end if + end do + end if - end associate + ! Deallocate memory local to this routine + deallocate(mass_ext_phobic) + deallocate(ssa_phobic) + deallocate(g_phobic) + deallocate(lidar_ratio_phobic) + if (ao%use_hydrophilic) then + deallocate(mass_ext_philic) + deallocate(ssa_philic) + deallocate(g_philic) + deallocate(lidar_ratio_philic) + end if if (lhook) call dr_hook('radiation_aerosol_optics:setup_general_aerosol_optics',1,hook_handle) @@ -346,11 +341,7 @@ subroutine setup_general_aerosol_optics_legacy(config, file_name) use parkind1, only : jprb use yomhook, only : lhook, dr_hook, jphook -#ifdef EASY_NETCDF_READ_MPI use easy_netcdf_read_mpi, only : netcdf_file -#else - use easy_netcdf, only : netcdf_file -#endif use radiation_config, only : config_type use radiation_aerosol_optics_data, only : aerosol_optics_type use radiation_spectral_definition, only : SolarReferenceTemperature, & @@ -485,7 +476,7 @@ end subroutine setup_general_aerosol_optics_legacy ! Compute aerosol optical properties and add to existing gas optical ! depth and scattering properties subroutine add_aerosol_optics(nlev,istartcol,iendcol, & - & config, thermodynamics, gas, aerosol, & + & config, thermodynamics, gas, aerosol, & & od_lw, ssa_lw, g_lw, od_sw, ssa_sw, g_sw) use parkind1, only : jprb @@ -501,7 +492,7 @@ subroutine add_aerosol_optics(nlev,istartcol,iendcol, & & IAerosolClassHydrophobic, IAerosolClassHydrophilic real(jprb), parameter :: OneOverAccelDueToGravity = 1.0_jprb / AccelDueToGravity - + integer, intent(in) :: nlev ! number of model levels integer, intent(in) :: istartcol, iendcol ! range of columns to process type(config_type), intent(in), target :: config @@ -534,7 +525,7 @@ subroutine add_aerosol_optics(nlev,istartcol,iendcol, & & :: scat_lw_aerosol, scat_g_lw_aerosol real(jprb) :: local_od_sw, local_od_lw - + real(jprb) :: h2o_mmr(istartcol:iendcol,nlev) real(jprb) :: rh ! Relative humidity with respect to liquid water @@ -549,7 +540,7 @@ subroutine add_aerosol_optics(nlev,istartcol,iendcol, & ! Aerosol mixing ratio as a scalar real(jprb) :: mixing_ratio - + ! Loop indices for column, level, g point, band and aerosol type integer :: jcol, jlev, jg, jtype, jband @@ -573,7 +564,7 @@ subroutine add_aerosol_optics(nlev,istartcol,iendcol, & ! Aerosol optical properties have been provided in each band ! directly by the user call add_aerosol_optics_direct(nlev,istartcol,iendcol, & - & config, aerosol, & + & config, aerosol, & & od_lw, ssa_lw, g_lw, od_sw, ssa_sw, g_sw) else ! Aerosol mixing ratios have been provided @@ -627,12 +618,12 @@ subroutine add_aerosol_optics(nlev,istartcol,iendcol, & ! hydrophilic-aerosol data rh = h2o_mmr(jcol,jlev) / thermodynamics%h2o_sat_liq(jcol,jlev) irhs(jlev) = ao%calc_rh_index(rh) - + factor(jlev) = ( thermodynamics%pressure_hl(jcol,jlev+1) & & -thermodynamics%pressure_hl(jcol,jlev ) ) & - & * OneOverAccelDueToGravity + & * OneOverAccelDueToGravity end do - + do jtype = 1,config%n_aerosol_types itype = ao%itype(jtype) @@ -677,11 +668,11 @@ subroutine add_aerosol_optics(nlev,istartcol,iendcol, & end do end if end do - + else if (ao%iclass(jtype) == IAerosolClassHydrophilic) then ! Hydrophilic aerosols require the look-up tables to ! be indexed with irh - do jlev = istartlev,iendlev + do jlev = istartlev,iendlev mixing_ratio = aerosol%mixing_ratio(jcol,jlev,jtype) irh = irhs(jlev) do jband = 1,config%n_bands_sw @@ -717,13 +708,13 @@ subroutine add_aerosol_optics(nlev,istartcol,iendcol, & end do end if end do - + ! Implicitly, if ao%iclass(jtype) == IAerosolClassNone, then ! no aerosol scattering properties are added end if end do ! Loop over aerosol type - + if (.not. config%do_sw_delta_scaling_with_gases) then ! Delta-Eddington scaling on aerosol only. Note that if ! do_sw_delta_scaling_with_gases==.true. then the delta @@ -778,7 +769,7 @@ subroutine add_aerosol_optics(nlev,istartcol,iendcol, & if (config%do_lw_aerosol_scattering) then call delta_eddington_extensive_vec(config%n_bands_lw*nlev, od_lw_aerosol, & - & scat_lw_aerosol, scat_g_lw_aerosol) + & scat_lw_aerosol, scat_g_lw_aerosol) do jlev = istartlev,iendlev do jg = 1,config%n_g_lw @@ -796,7 +787,7 @@ subroutine add_aerosol_optics(nlev,istartcol,iendcol, & end if end do end do - + else if (config%do_cloud_aerosol_per_lw_g_point) then @@ -816,7 +807,7 @@ subroutine add_aerosol_optics(nlev,istartcol,iendcol, & end if end if - + end do ! Loop over column end if @@ -830,7 +821,7 @@ end subroutine add_aerosol_optics ! Add precomputed optical properties to gas optical depth and ! scattering properties subroutine add_aerosol_optics_direct(nlev,istartcol,iendcol, & - & config, aerosol, & + & config, aerosol, & & od_lw, ssa_lw, g_lw, od_sw, ssa_sw, g_sw) use parkind1, only : jprb @@ -958,7 +949,7 @@ subroutine add_aerosol_optics_direct(nlev,istartcol,iendcol, & if (config%do_lw_aerosol_scattering) then ssa_lw(:,:,istartcol:iendcol) = 0.0_jprb g_lw(:,:,istartcol:iendcol) = 0.0_jprb - + ! Loop over position do jcol = istartcol,iendcol ! Added for DWD (2020) @@ -968,7 +959,7 @@ subroutine add_aerosol_optics_direct(nlev,istartcol,iendcol, & od_lw_aerosol(jb,jlev) = aerosol%od_lw(jb,jlev,jcol) scat_lw_aerosol(jb,jlev) = aerosol%ssa_lw(jb,jlev,jcol) * od_lw_aerosol(jb,jlev) scat_g_lw_aerosol(jb,jlev) = aerosol%g_lw(jb,jlev,jcol) * scat_lw_aerosol(jb,jlev) - + call delta_eddington_extensive(od_lw_aerosol(jb,jlev), scat_lw_aerosol(jb,jlev), & & scat_g_lw_aerosol(jb,jlev)) end do @@ -1021,7 +1012,7 @@ subroutine add_aerosol_optics_direct(nlev,istartcol,iendcol, & if (lhook) call dr_hook('radiation_aerosol_optics:add_aerosol_optics_direct',1,hook_handle) end subroutine add_aerosol_optics_direct - + !--------------------------------------------------------------------- ! Sometimes it is useful to specify aerosol in terms of its optical @@ -1046,7 +1037,7 @@ function dry_aerosol_mass_extinction(config, itype, wavelength) ! Wavelength (m) real(jprb), intent(in) :: wavelength - + real(jprb) :: dry_aerosol_mass_extinction ! Index to the monochromatic wavelength requested @@ -1108,7 +1099,7 @@ subroutine aerosol_extinction(ncol,istartcol,iendcol, & ! Pointer to the aerosol optics coefficients for brevity of access type(aerosol_optics_type), pointer :: ao - + ! Loop indices for column and aerosol type integer :: jcol, jtype diff --git a/radiation/radiation_aerosol_optics_data.F90 b/radiation/radiation_aerosol_optics_data.F90 index 9e2f9148..cf8db676 100644 --- a/radiation/radiation_aerosol_optics_data.F90 +++ b/radiation/radiation_aerosol_optics_data.F90 @@ -16,7 +16,6 @@ ! 2017-10-23 R. Hogan Renamed single-character variables ! 2018-04-20 A. Bozzo Read optical properties at selected wavelengths -#include "ecrad_config.h" module radiation_aerosol_optics_data @@ -36,12 +35,12 @@ module radiation_aerosol_optics_data ! tries to use this aerosol type. The user may specify that an ! aerosol type is to be ignored in the radiation calculation, in ! which case iclass will be set equal to AerosolClassIgnored. - enum, bind(c) + enum, bind(c) enumerator IAerosolClassUndefined, IAerosolClassIgnored, & & IAerosolClassHydrophobic, IAerosolClassHydrophilic end enum - integer, parameter :: NMaxStringLength = 20000 + integer, parameter :: NMaxStringLength = 2000 integer, parameter :: NMaxLineLength = 200 !--------------------------------------------------------------------- @@ -157,11 +156,7 @@ module radiation_aerosol_optics_data subroutine setup_aerosol_optics(this, file_name, iverbose) use yomhook, only : lhook, dr_hook, jphook -#ifdef EASY_NETCDF_READ_MPI use easy_netcdf_read_mpi, only : netcdf_file -#else - use easy_netcdf, only : netcdf_file -#endif use radiation_io, only : nulerr, radiation_abort class(aerosol_optics_type), intent(inout) :: this @@ -321,7 +316,7 @@ subroutine initialize_types(this, ntype) class(aerosol_optics_type), intent(inout) :: this integer, intent(in) :: ntype - + ! Allocate memory for mapping arrays this%ntype = ntype allocate(this%iclass(ntype)) @@ -402,11 +397,10 @@ end subroutine allocate !--------------------------------------------------------------------- - ! Save aerosol optical properties in the named file subroutine save_aerosol_optics(this, file_name, iverbose) - use yomhook, only : lhook, dr_hook, jphook - use easy_netcdf, only : netcdf_file + use yomhook, only : lhook, dr_hook, jphook + use easy_netcdf, only : netcdf_file class(aerosol_optics_type), intent(inout) :: this character(len=*), intent(in) :: file_name @@ -548,7 +542,7 @@ subroutine set_hydrophilic_type(this, itype, i_type_philic) if (.not. this%use_hydrophilic) then write(nulerr,'(a)') '*** Error: attempt to set hydrophilic aerosol type when no such types present' - call radiation_abort('Error setting up aerosols') + call radiation_abort('Error setting up aerosols') end if if (itype < 1 .or. itype > this%ntype) then @@ -641,7 +635,7 @@ function calc_rh_index(this, rh) !use yomhook, only : lhook, dr_hook, jphook - class(aerosol_optics_type), intent(in) :: this + class(aerosol_optics_type), intent(inout) :: this real(jprb), intent(in) :: rh integer :: calc_rh_index !real(jphook) :: hook_handle @@ -692,7 +686,7 @@ subroutine print_description(this, i_type_map) write(nulout,'(i4,a)') jtype, ' is unused' end if end do - + end subroutine print_description @@ -702,10 +696,10 @@ pure function get_line(str,iline) result(line_str) character(len=*), intent(in) :: str integer, intent(in) :: iline character(len=NMaxLineLength) :: line_str - + integer :: istart, iend, i_start_new, ioffset, ilength, i_line_current logical :: is_fail - + i_line_current = 1 istart = 1 iend = len(str) @@ -717,13 +711,13 @@ pure function get_line(str,iline) result(line_str) i_start_new = scan(str(istart:iend), new_line(' ')) if (i_start_new == 0) then is_fail = .true. - exit + cycle else istart = istart + i_start_new end if i_line_current = i_line_current + 1 end do - + if (.not. is_fail) then ! Find index of last character ioffset = scan(str(istart:iend), new_line(' ')) @@ -732,17 +726,17 @@ pure function get_line(str,iline) result(line_str) else ilength = ioffset - 1 end if - + if (ilength > NMaxLineLength) then ilength = NMaxLineLength end if iend = istart + ilength - 1 - + line_str = str(istart:iend) else write(line_str,'(i0,a)') iline, ': ' end if - + end function get_line - + end module radiation_aerosol_optics_data diff --git a/radiation/radiation_aerosol_optics_description.F90 b/radiation/radiation_aerosol_optics_description.F90 index 3dac6dc9..1c2dce9e 100644 --- a/radiation/radiation_aerosol_optics_description.F90 +++ b/radiation/radiation_aerosol_optics_description.F90 @@ -13,8 +13,6 @@ ! Email: r.j.hogan@ecmwf.int ! -#include "ecrad_config.h" - module radiation_aerosol_optics_description use parkind1, only : jprb @@ -79,11 +77,7 @@ module radiation_aerosol_optics_description subroutine read(this, file_name, iverbose) use yomhook, only : lhook, dr_hook, jphook -#ifdef EASY_NETCDF_READ_MPI - use easy_netcdf_read_mpi, only : netcdf_file -#else use easy_netcdf, only : netcdf_file -#endif class(aerosol_optics_description_type), intent(inout) :: this character(len=*), intent(in) :: file_name @@ -222,6 +216,7 @@ end subroutine preferred_optical_model function get_index(this, code_str, lhydrophilic, ibin, optical_model_str) use yomhook, only : lhook, dr_hook, jphook + use easy_netcdf, only : netcdf_file use radiation_io, only : nulout class(aerosol_optics_description_type), intent(in) :: this @@ -357,7 +352,7 @@ function get_index(this, code_str, lhydrophilic, ibin, optical_model_str) end if if (is_ambiguous) then - write(nulout,'(a,a2,a,l1,a)') 'Warning: radiation_aerosol_optics_description:get_index("', & + write(nulout,'(a,a2,a,l,a)') 'Warning: radiation_aerosol_optics_description:get_index("', & & code_str, '",', lhydrophilic, & & ',...) does not unambiguously identify an aerosol optical property index' end if diff --git a/radiation/radiation_cloud.F90 b/radiation/radiation_cloud.F90 index 173d617c..2b453376 100644 --- a/radiation/radiation_cloud.F90 +++ b/radiation/radiation_cloud.F90 @@ -81,9 +81,7 @@ module radiation_cloud contains procedure :: allocate => allocate_cloud_arrays procedure :: deallocate => deallocate_cloud_arrays - procedure :: set_overlap_param_fix - procedure :: set_overlap_param_var - generic :: set_overlap_param => set_overlap_param_fix, set_overlap_param_var + procedure :: set_overlap_param procedure :: set_overlap_param_approx procedure :: create_fractional_std procedure :: create_inv_cloud_effective_size @@ -191,9 +189,8 @@ end subroutine deallocate_cloud_arrays ! provided then only columns in this range are computed. If the ! overlap_param array has not been allocated then it will be ! allocated to be of the correct size relative to the pressure - ! field. This version assumes a fixed decorrelation_length for all - ! columns. - subroutine set_overlap_param_fix(this, thermodynamics, decorrelation_length, & + ! field. + subroutine set_overlap_param(this, thermodynamics, decorrelation_length, & & istartcol, iendcol) use yomhook, only : lhook, dr_hook, jphook @@ -218,7 +215,7 @@ subroutine set_overlap_param_fix(this, thermodynamics, decorrelation_length, & real(jphook) :: hook_handle - if (lhook) call dr_hook('radiation_cloud:set_overlap_param_fix',0,hook_handle) + if (lhook) call dr_hook('radiation_cloud:set_overlap_param',0,hook_handle) ! Pressure at half-levels, pressure_hl, is defined at nlev+1 ! points @@ -286,98 +283,9 @@ subroutine set_overlap_param_fix(this, thermodynamics, decorrelation_length, & end do end if - if (lhook) call dr_hook('radiation_cloud:set_overlap_param_fix',1,hook_handle) + if (lhook) call dr_hook('radiation_cloud:set_overlap_param',1,hook_handle) - end subroutine set_overlap_param_fix - - - !--------------------------------------------------------------------- - ! Compute and store the overlap parameter from the provided overlap - ! decorrelation length (in metres), which may vary with column. Only - ! columns from istartcol to iendcol are computed. If the - ! overlap_param array has not been allocated then it will be - ! allocated to be of the correct size relative to the pressure - ! field. - subroutine set_overlap_param_var(this, thermodynamics, decorrelation_length, & - & istartcol, iendcol) - - use yomhook, only : lhook, dr_hook, jphook - use radiation_thermodynamics, only : thermodynamics_type - use radiation_constants, only : GasConstantDryAir, AccelDueToGravity - - class(cloud_type), intent(inout) :: this - type(thermodynamics_type), intent(in) :: thermodynamics - integer, intent(in) :: istartcol, iendcol - real(jprb), intent(in) :: decorrelation_length(istartcol:iendcol) ! m - - ! Ratio of gas constant for dry air to acceleration due to gravity - real(jprb), parameter :: R_over_g = GasConstantDryAir / AccelDueToGravity - - integer :: ncol, nlev - - integer :: jcol, jlev - - real(jphook) :: hook_handle - - if (lhook) call dr_hook('radiation_cloud:set_overlap_param_var',0,hook_handle) - - ! Pressure at half-levels, pressure_hl, is defined at nlev+1 - ! points - ncol = size(thermodynamics%pressure_hl,dim=1) - nlev = size(thermodynamics%pressure_hl,dim=2)-1 - - if (.not. allocated(this%overlap_param)) then - ! If pressure is of size (ncol,nlev+1) then overlap_param is of - ! size (ncol,nlev-1), since overlap parameter is only defined here - ! for interfaces between model layers, not for the interface to - ! space or the surface - allocate(this%overlap_param(ncol, nlev-1)) - end if - - if (thermodynamics%pressure_hl(istartcol,2) > thermodynamics%pressure_hl(istartcol,1)) then - ! Pressure is increasing with index (order of layers is - ! top-of-atmosphere to surface). In case pressure_hl(:,1)=0, we - ! don't take the logarithm of the first pressure in each column. - do jcol = istartcol,iendcol - this%overlap_param(jcol,1) = exp(-(R_over_g/decorrelation_length(jcol)) & - & * thermodynamics%temperature_hl(jcol,2) & - & *log(thermodynamics%pressure_hl(jcol,3) & - & /thermodynamics%pressure_hl(jcol,2))) - end do - - do jlev = 2,nlev-1 - do jcol = istartcol,iendcol - this%overlap_param(jcol,jlev) = exp(-(0.5_jprb*R_over_g/decorrelation_length(jcol)) & - & * thermodynamics%temperature_hl(jcol,jlev+1) & - & *log(thermodynamics%pressure_hl(jcol,jlev+2) & - & /thermodynamics%pressure_hl(jcol,jlev))) - end do - end do - - else - ! Pressure is decreasing with index (order of layers is surface - ! to top-of-atmosphere). In case pressure_hl(:,nlev+1)=0, we - ! don't take the logarithm of the last pressure in each column. - do jlev = 1,nlev-2 - do jcol = istartcol,iendcol - this%overlap_param(jcol,jlev) = exp(-(0.5_jprb*R_over_g/decorrelation_length(jcol)) & - & * thermodynamics%temperature_hl(jcol,jlev+1) & - & *log(thermodynamics%pressure_hl(jcol,jlev) & - & /thermodynamics%pressure_hl(jcol,jlev+2))) - end do - end do - - do jcol = istartcol,iendcol - this%overlap_param(jcol,nlev-1) = exp(-(R_over_g/decorrelation_length(jcol)) & - & * thermodynamics%temperature_hl(jcol,nlev) & - & *log(thermodynamics%pressure_hl(jcol,nlev-1) & - & /thermodynamics%pressure_hl(jcol,nlev))) - end do - end if - - if (lhook) call dr_hook('radiation_cloud:set_overlap_param_var',1,hook_handle) - - end subroutine set_overlap_param_var + end subroutine set_overlap_param !--------------------------------------------------------------------- diff --git a/radiation/radiation_cloud_cover.F90 b/radiation/radiation_cloud_cover.F90 index 57cb93ba..ccac301c 100644 --- a/radiation/radiation_cloud_cover.F90 +++ b/radiation/radiation_cloud_cover.F90 @@ -1,5 +1,3 @@ -! radiation_cloud_cover.F90 - Compute cumulative cloud cover for McICA -! ! (C) Copyright 2016- ECMWF. ! ! This software is licensed under the terms of the Apache Licence Version 2.0 @@ -8,6 +6,8 @@ ! In applying this licence, ECMWF does not waive the privileges and immunities ! granted to it by virtue of its status as an intergovernmental organisation ! nor does it submit to any jurisdiction. + +! radiation_cloud_cover.F90 - Compute cumulative cloud cover for McICA ! ! Author: Robin Hogan ! Email: r.j.hogan@ecmwf.int @@ -18,8 +18,6 @@ ! Modifications ! 2020-10-07 R. Hogan Ensure iobj1 initialized in case of alpha_obj==0 -#include "ecrad_config.h" - module radiation_cloud_cover use parkind1, only : jprb @@ -81,7 +79,7 @@ function cloud_cover(nlev, i_overlap_scheme, frac, overlap_param, & & is_beta_overlap) implicit none - + ! Number of levels and the overlap scheme to be applied integer, intent(in) :: nlev, i_overlap_scheme @@ -175,7 +173,7 @@ subroutine cum_cloud_cover_max_ran(nlev, frac, & if (lhook) call dr_hook('radiation_cloud_cover:cum_cloud_cover_max_ran',1,hook_handle) end subroutine cum_cloud_cover_max_ran - + !--------------------------------------------------------------------- ! Exponential-random overlap: exponential overlap for contiguous @@ -229,7 +227,7 @@ subroutine cum_cloud_cover_exp_ran(nlev, frac, overlap_param, & if (lhook) call dr_hook('radiation_cloud_cover:cum_cloud_cover_exp_ran',0,hook_handle) - + if (present(is_beta_overlap)) then do_overlap_conversion = is_beta_overlap else @@ -255,7 +253,7 @@ subroutine cum_cloud_cover_exp_ran(nlev, frac, overlap_param, & & + (1.0_jprb - overlap_alpha) & & * (frac(jlev)+frac(jlev+1)-frac(jlev)*frac(jlev+1)) ! Added for DWD (2020) -#ifdef DWD_VECTOR_OPTIMIZATIONS +#ifdef __SX__ end do do jlev = 1,nlev-1 #endif @@ -373,7 +371,7 @@ subroutine cum_cloud_cover_exp_exp(nlev, frac, overlap_param, & if (lhook) call dr_hook('radiation_cloud_cover:cum_cloud_cover_exp_exp',0,hook_handle) - + if (present(is_beta_overlap)) then do_overlap_conversion = is_beta_overlap else @@ -391,7 +389,7 @@ subroutine cum_cloud_cover_exp_exp(nlev, frac, overlap_param, & i_top_obj(nobj) = jlev; ! Find its maximum cloud fraction jlev = jlev + 1 - do while (jlev <= nlev) + do while (jlev <= nlev) if (frac(jlev) < frac(jlev-1)) then exit end if @@ -428,7 +426,7 @@ subroutine cum_cloud_cover_exp_exp(nlev, frac, overlap_param, & if (nobj > 0) then ! Only do any more work if there is cloud present - + ! To minimize the potential calls to beta2alpha, we do all the ! computations related to overlap parameter here if (.not. do_overlap_conversion) then @@ -459,7 +457,7 @@ subroutine cum_cloud_cover_exp_exp(nlev, frac, overlap_param, & pair_cloud_cover(jlev) & & = overlap_alpha(jlev)*max(frac(jlev),frac(jlev+1)) & & + (1.0_jprb - overlap_alpha(jlev)) & - & * (frac(jlev)+frac(jlev+1)-frac(jlev)*frac(jlev+1)) + & * (frac(jlev)+frac(jlev+1)-frac(jlev)*frac(jlev+1)) end do ! Estimate the effective overlap parameter "alpha_obj" between ! adjacent objects as the product of the layerwise overlap @@ -529,14 +527,14 @@ subroutine cum_cloud_cover_exp_exp(nlev, frac, overlap_param, & scaling = min(max((cc_pair-cc_obj(iobj1)) / max(min_frac, cc_obj(iobj2)), & & 0.0_jprb), & & 1.0_jprb) - + ! Scale the combined cloud cover of the lower object to ! account for its overlap with the upper object do jlev = i_top_obj(iobj2),i_base_obj(iobj2) cum_cloud_cover(jlev) = cum_cloud_cover(i_base_obj(iobj1)) & + cum_cloud_cover(jlev) * scaling end do - + ! Merge the objects by setting the properties of the upper ! object to the combined properties of both. Note that ! i_max_obj is not modified because it is no longer needed. @@ -549,7 +547,7 @@ subroutine cum_cloud_cover_exp_exp(nlev, frac, overlap_param, & ! Finish off the total cloud cover below cloud cum_cloud_cover(i_base_obj(iobj1)+1:nlev) & - & = cum_cloud_cover(i_base_obj(iobj1)) + & = cum_cloud_cover(i_base_obj(iobj1)) ! Ensure that the combined cloud cover of pairs of layers is ! consistent with the overhang diff --git a/radiation/radiation_cloud_generator.F90 b/radiation/radiation_cloud_generator.F90 index ecf16765..5cb8f6cb 100644 --- a/radiation/radiation_cloud_generator.F90 +++ b/radiation/radiation_cloud_generator.F90 @@ -18,6 +18,7 @@ ! Modifications ! 2018-02-22 R. Hogan Call masked version of PDF sampler for speed ! 2020-03-31 R. Hogan More vectorizable version of Exp-Ran +! 2025-08-06 R. El Khatib Optimization module radiation_cloud_generator @@ -36,7 +37,7 @@ module radiation_cloud_generator ! reduce the Monte Carlo noise in profiles with low cloud cover. subroutine cloud_generator(ng, nlev, i_overlap_scheme, & & iseed, frac_threshold, & - & frac, overlap_param, decorrelation_scaling, & + & frac, overlap_param, reverse_decorrelation_scaling, & & fractional_std, pdf_sampler, & & od_scaling, total_cloud_cover, & & use_beta_overlap, use_vectorizable_generator) @@ -73,7 +74,7 @@ subroutine cloud_generator(ng, nlev, i_overlap_scheme, & real(jprb), intent(in) :: overlap_param(nlev-1) ! Overlap parameter for internal inhomogeneities - real(jprb), intent(in) :: decorrelation_scaling + real(jprb), intent(in) :: reverse_decorrelation_scaling ! Fractional standard deviation at each layer real(jprb), intent(in) :: fractional_std(nlev) @@ -117,11 +118,11 @@ subroutine cloud_generator(ng, nlev, i_overlap_scheme, & ! Seed for random number generator and stream for producing random ! numbers type(randomnumberstream) :: random_stream - + ! First and last cloudy layers integer :: ibegin, iend - integer :: itrigger + integer, dimension(ng) :: itrigger ! Loop index for model level and g-point integer :: jlev, jg @@ -165,7 +166,7 @@ subroutine cloud_generator(ng, nlev, i_overlap_scheme, & ! Find range of cloudy layers jlev = 1 - do while (frac(jlev) <= 0.0_jprb) + do while (frac(jlev) <= 0.0_jprb) jlev = jlev + 1 end do ibegin = jlev @@ -182,7 +183,8 @@ subroutine cloud_generator(ng, nlev, i_overlap_scheme, & do jlev = ibegin,iend-1 if (overlap_param(jlev) > 0.0_jprb) then overlap_param_inhom(jlev) & - & = overlap_param(jlev)**(1.0_jprb/decorrelation_scaling) + & = overlap_param(jlev)**reverse_decorrelation_scaling + end if end do @@ -205,7 +207,7 @@ subroutine cloud_generator(ng, nlev, i_overlap_scheme, & ! Compute ng random numbers to use to locate cloud top call uniform_distribution(rand_top, random_stream) - + ! Loop over ng columns do jg = 1,ng ! Find the cloud top height corresponding to the current @@ -215,21 +217,19 @@ subroutine cloud_generator(ng, nlev, i_overlap_scheme, & do while (trigger > cum_cloud_cover(jlev) .and. jlev < iend) jlev = jlev + 1 end do - itrigger = jlev - - if (i_overlap_scheme /= IOverlapExponential) then - call generate_column_exp_ran(ng, nlev, jg, random_stream, pdf_sampler, & + itrigger(jg) = jlev + end do + if (i_overlap_scheme /= IOverlapExponential) then + call generate_column_exp_ran(ng, nlev, random_stream, pdf_sampler, & & frac, pair_cloud_cover, & & cum_cloud_cover, overhang, fractional_std, overlap_param_inhom, & & itrigger, iend, od_scaling) - else - call generate_column_exp_exp(ng, nlev, jg, random_stream, pdf_sampler, & + else + call generate_column_exp_exp(ng, nlev, random_stream, pdf_sampler, & & frac, pair_cloud_cover, & & cum_cloud_cover, overhang, fractional_std, overlap_param_inhom, & & itrigger, iend, od_scaling) - end if - - end do + end if else ! Alternative generator (only for Exp-Ran overlap so far) that @@ -259,7 +259,7 @@ end subroutine cloud_generator ! Generate a column of optical depth scalings using ! exponential-random overlap (which includes maximum-random overlap ! as a limiting case) - subroutine generate_column_exp_ran(ng, nlev, ig, random_stream, pdf_sampler, & + subroutine generate_column_exp_ran(ng, nlev, random_stream, pdf_sampler, & & frac, pair_cloud_cover, & & cum_cloud_cover, overhang, fractional_std, overlap_param_inhom, & & itrigger, iend, od_scaling) @@ -273,7 +273,7 @@ subroutine generate_column_exp_ran(ng, nlev, ig, random_stream, pdf_sampler, & implicit none ! Number of g points / columns, and number of current column - integer, intent(in) :: ng, ig + integer, intent(in) :: ng ! Number of levels integer, intent(in) :: nlev @@ -297,13 +297,14 @@ subroutine generate_column_exp_ran(ng, nlev, ig, random_stream, pdf_sampler, & ! Top of highest cloudy layer (in this subcolumn) and base of ! lowest - integer, intent(in) :: itrigger, iend + integer, intent(in), dimension(ng) :: itrigger + integer, intent(in) :: iend ! Optical depth scaling to output real(jprb), intent(inout), dimension(ng,nlev) :: od_scaling ! Height indices - integer :: jlev, jcloud + integer :: jlev, jcloud, ig ! Number of contiguous cloudy layers for which to compute optical ! depth scaling @@ -315,7 +316,10 @@ subroutine generate_column_exp_ran(ng, nlev, ig, random_stream, pdf_sampler, & logical :: do_fill_od_scaling real(jprb) :: rand_cloud(nlev) - real(jprb) :: rand_inhom1(nlev), rand_inhom2(nlev) + real(jprb),pointer :: rand_inhom1(:), rand_inhom2(:) + real(jprb),target :: rand_inhom(2*nlev) + + do ig = 1,ng ! So far our vertically contiguous cloud contains only one layer n_layers_to_scale = 1 @@ -323,11 +327,11 @@ subroutine generate_column_exp_ran(ng, nlev, ig, random_stream, pdf_sampler, & ! Locate the clouds below this layer: first generate some more ! random numbers - call uniform_distribution(rand_cloud(1:(iend+1-itrigger)),random_stream) + call uniform_distribution(rand_cloud(1:(iend+1-itrigger(ig))),random_stream) ! Loop from the layer below the local cloud top down to the ! bottom-most cloudy layer - do jlev = itrigger+1,iend+1 + do jlev = itrigger(ig)+1,iend+1 do_fill_od_scaling = .false. if (jlev <= iend) then iy = iy+1 @@ -338,7 +342,7 @@ subroutine generate_column_exp_ran(ng, nlev, ig, random_stream, pdf_sampler, & & < frac(jlev) + frac(jlev-1) - pair_cloud_cover(jlev-1)) then ! Add another cloudy layer n_layers_to_scale = n_layers_to_scale + 1 - else + else ! Reached the end of a contiguous set of cloudy layers and ! will compute the optical depth scaling immediately. do_fill_od_scaling = .true. @@ -362,8 +366,10 @@ subroutine generate_column_exp_ran(ng, nlev, ig, random_stream, pdf_sampler, & ! We have a contiguous range of layers for which we ! compute the od_scaling elements using some random ! numbers - call uniform_distribution(rand_inhom1(1:n_layers_to_scale),random_stream) - call uniform_distribution(rand_inhom2(1:n_layers_to_scale),random_stream) + call uniform_distribution(rand_inhom(1:2*n_layers_to_scale),random_stream) + rand_inhom1 => rand_inhom(1:n_layers_to_scale) + rand_inhom2 => rand_inhom(n_layers_to_scale+1:n_layers_to_scale+n_layers_to_scale) + ! Loop through the sequence of cloudy layers do jcloud = 2,n_layers_to_scale @@ -376,7 +382,7 @@ subroutine generate_column_exp_ran(ng, nlev, ig, random_stream, pdf_sampler, & rand_inhom1(jcloud) = rand_inhom1(jcloud-1) end if end do - + ! Sample from a lognormal or gamma distribution to obtain ! the optical depth scalings call pdf_sampler%sample(fractional_std(jlev-n_layers_to_scale:jlev-1), & @@ -384,8 +390,10 @@ subroutine generate_column_exp_ran(ng, nlev, ig, random_stream, pdf_sampler, & n_layers_to_scale = 0 end if + + end do ! jlev - end do + end do ! ig end subroutine generate_column_exp_ran @@ -393,7 +401,7 @@ end subroutine generate_column_exp_ran !--------------------------------------------------------------------- ! Generate a column of optical depth scalings using ! exponential-exponential overlap - subroutine generate_column_exp_exp(ng, nlev, ig, random_stream, pdf_sampler, & + subroutine generate_column_exp_exp(ng, nlev, random_stream, pdf_sampler, & & frac, pair_cloud_cover, & & cum_cloud_cover, overhang, fractional_std, overlap_param_inhom, & & itrigger, iend, od_scaling) @@ -406,7 +414,7 @@ subroutine generate_column_exp_exp(ng, nlev, ig, random_stream, pdf_sampler, & implicit none ! Number of g points / columns, and number of current column - integer, intent(in) :: ng, ig + integer, intent(in) :: ng ! Number of levels integer, intent(in) :: nlev @@ -430,18 +438,20 @@ subroutine generate_column_exp_exp(ng, nlev, ig, random_stream, pdf_sampler, & ! Top of highest cloudy layer (in this subcolumn) and base of ! lowest - integer, intent(in) :: itrigger, iend + integer, intent(in), dimension(ng) :: itrigger + integer, intent(in) :: iend ! Optical depth scaling to output real(jprb), intent(inout), dimension(ng,nlev) :: od_scaling ! Height indices - integer :: jlev, jcloud + integer :: jlev, jcloud, ig integer :: iy real(jprb) :: rand_cloud(nlev) - real(jprb) :: rand_inhom1(nlev), rand_inhom2(nlev) + real(jprb),pointer :: rand_inhom1(:), rand_inhom2(:) + real(jprb),target :: rand_inhom(2*nlev) ! For each column analysed, this vector locates the clouds. It is ! only actually used for Exp-Exp overlap @@ -451,18 +461,20 @@ subroutine generate_column_exp_exp(ng, nlev, ig, random_stream, pdf_sampler, & ! depth scaling integer :: n_layers_to_scale + do ig = 1,ng + iy = 0 is_cloudy = .false. - is_cloudy(itrigger) = .true. + is_cloudy(itrigger(ig)) = .true. ! Locate the clouds below this layer: first generate some more ! random numbers - call uniform_distribution(rand_cloud(1:(iend+1-itrigger)),random_stream) + call uniform_distribution(rand_cloud(1:(iend+1-itrigger(ig))),random_stream) ! Loop from the layer below the local cloud top down to the ! bottom-most cloudy layer - do jlev = itrigger+1,iend + do jlev = itrigger(ig)+1,iend iy = iy+1 if (is_cloudy(jlev-1)) then ! There is a cloud above, in which case the probability @@ -487,11 +499,12 @@ subroutine generate_column_exp_exp(ng, nlev, ig, random_stream, pdf_sampler, & ! od_scaling elements using some random numbers ! In the Exp-Exp overlap scheme we do all layers at once - n_layers_to_scale = iend+1 - itrigger - - call uniform_distribution(rand_inhom1(1:n_layers_to_scale),random_stream) - call uniform_distribution(rand_inhom2(1:n_layers_to_scale),random_stream) - + n_layers_to_scale = iend+1 - itrigger(ig) + + call uniform_distribution(rand_inhom(1:2*n_layers_to_scale),random_stream) + rand_inhom1 => rand_inhom(1:n_layers_to_scale) + rand_inhom2 => rand_inhom(n_layers_to_scale+1:n_layers_to_scale+n_layers_to_scale) + ! Loop through the sequence of cloudy layers do jcloud = 2,n_layers_to_scale ! Use second random number, and inhomogeneity overlap @@ -503,30 +516,33 @@ subroutine generate_column_exp_exp(ng, nlev, ig, random_stream, pdf_sampler, & rand_inhom1(jcloud) = rand_inhom1(jcloud-1) end if end do - + ! Sample from a lognormal or gamma distribution to obtain the ! optical depth scalings ! Masked version assuming values outside the range itrigger:iend ! are already zero: call pdf_sampler%masked_sample(n_layers_to_scale, & - & fractional_std(itrigger:iend), & - & rand_inhom1(1:n_layers_to_scale), od_scaling(ig,itrigger:iend), & - & is_cloudy(itrigger:iend)) - + & fractional_std(itrigger(ig):iend), & + & rand_inhom1(1:n_layers_to_scale), od_scaling(ig,itrigger(ig):iend), & + & is_cloudy(itrigger(ig):iend)) + ! ! IFS version: - ! !$omp simd - ! do jlev=itrigger,iend + ! !$omp simd + ! do jlev=itrigger(ig),iend ! if (.not. is_cloudy(jlev)) then ! od_scaling(ig,jlev) = 0.0_jprb ! else ! call sample_from_pdf_simd(& ! pdf_sampler,fractional_std(jlev),& - ! rand_inhom1(jlev-itrigger+1), & + ! rand_inhom1(jlev-itrigger(ig)+1), & ! od_scaling(ig,jlev)) ! end if ! end do + end do ! ig + + end subroutine generate_column_exp_exp @@ -535,45 +551,45 @@ end subroutine generate_column_exp_exp ! standard deviation "fsd" corresponding to the cumulative ! distribution function value "cdf", and return it in x. Since this ! is an elemental subroutine, fsd, cdf and x may be arrays. SIMD version. - subroutine sample_from_pdf_simd(this, fsd, cdf, x) - use parkind1, only : jprb - use radiation_pdf_sampler, only : pdf_sampler_type - implicit none -#if defined(__GFORTRAN__) || defined(__PGI) || defined(__NEC__) || defined(__INTEL_LLVM_COMPILER) -#else - !$omp declare simd(sample_from_pdf_simd) uniform(this) & - !$omp linear(ref(fsd)) linear(ref(cdf)) -#endif - type(pdf_sampler_type), intent(in) :: this - - ! Fractional standard deviation (0 to 4) and cumulative - ! distribution function (0 to 1) - real(jprb), intent(in) :: fsd, cdf - - ! Sample from distribution - real(jprb), intent(out) :: x - +! subroutine sample_from_pdf_simd(this, fsd, cdf, x) +! use parkind1, only : jprb +! use radiation_pdf_sampler, only : pdf_sampler_type +! implicit none +!#if defined(__GFORTRAN__) || defined(__PGI) || defined(__NEC__) +!#else +! !$omp declare simd(sample_from_pdf_simd) uniform(this) & +! !$omp linear(ref(fsd)) linear(ref(cdf)) +!#endif +! type(pdf_sampler_type), intent(in) :: this +! +! ! Fractional standard deviation (0 to 4) and cumulative +! ! distribution function (0 to 1) +! real(jprb), intent(in) :: fsd, cdf +! +! ! Sample from distribution +! real(jprb), intent(out) :: x +! ! Index to look-up table - integer :: ifsd, icdf - - ! Weights in bilinear interpolation - real(jprb) :: wfsd, wcdf - - ! Bilinear interpolation with bounds - wcdf = cdf * (this%ncdf-1) + 1.0_jprb - icdf = max(1, min(int(wcdf), this%ncdf-1)) - wcdf = max(0.0_jprb, min(wcdf - icdf, 1.0_jprb)) - - wfsd = (fsd-this%fsd1) * this%inv_fsd_interval + 1.0_jprb - ifsd = max(1, min(int(wfsd), this%nfsd-1)) - wfsd = max(0.0_jprb, min(wfsd - ifsd, 1.0_jprb)) - - x = (1.0_jprb-wcdf)*(1.0_jprb-wfsd) * this%val(icdf ,ifsd) & - & + (1.0_jprb-wcdf)* wfsd * this%val(icdf ,ifsd+1) & - & + wcdf *(1.0_jprb-wfsd) * this%val(icdf+1,ifsd) & - & + wcdf * wfsd * this%val(icdf+1,ifsd+1) - - end subroutine sample_from_pdf_simd +! integer :: ifsd, icdf +! +! ! Weights in bilinear interpolation +! real(jprb) :: wfsd, wcdf +! +! ! Bilinear interpolation with bounds +! wcdf = cdf * (this%ncdf-1) + 1.0_jprb +! icdf = max(1, min(int(wcdf), this%ncdf-1)) +! wcdf = max(0.0_jprb, min(wcdf - icdf, 1.0_jprb)) +! +! wfsd = (fsd-this%fsd1) * this%inv_fsd_interval + 1.0_jprb +! ifsd = max(1, min(int(wfsd), this%nfsd-1)) +! wfsd = max(0.0_jprb, min(wfsd - ifsd, 1.0_jprb)) +! +! x = (1.0_jprb-wcdf)*(1.0_jprb-wfsd) * this%val(icdf ,ifsd) & +! & + (1.0_jprb-wcdf)* wfsd * this%val(icdf ,ifsd+1) & +! & + wcdf *(1.0_jprb-wfsd) * this%val(icdf+1,ifsd) & +! & + wcdf * wfsd * this%val(icdf+1,ifsd+1) +! +! end subroutine sample_from_pdf_simd !--------------------------------------------------------------------- @@ -723,7 +739,7 @@ subroutine generate_columns_exp_ran(ng, nlev, iseed, pdf_sampler, & is_cloud = .false. end if end do - + ! Sample from a lognormal or gamma distribution to obtain the ! optical depth scalings, calling the faster masked version and ! assuming values outside the range ibegin:iend are already zero diff --git a/radiation/radiation_cloud_optics.F90 b/radiation/radiation_cloud_optics.F90 index 4973c881..a87bc6cf 100644 --- a/radiation/radiation_cloud_optics.F90 +++ b/radiation/radiation_cloud_optics.F90 @@ -41,6 +41,7 @@ subroutine setup_cloud_optics(config) & IIceModelYi, & & ILiquidModelSOCRATES, ILiquidModelSlingo, & & ILiquidModelJahangir,ILiquidModelNielsen + use radiation_cloud_optics_data, only : cloud_optics_type use radiation_ice_optics_fu, only : NIceOpticsCoeffsFuSW, & & NIceOpticsCoeffsFuLW use radiation_ice_optics_baran, only : NIceOpticsCoeffsBaran, & @@ -76,7 +77,7 @@ subroutine setup_cloud_optics(config) & '*** Error: number of shortwave bands for droplets (', & & size(config%cloud_optics%liq_coeff_sw, 1), & & ') does not match number for gases (', config%n_bands_sw, ')' - call radiation_abort() + call radiation_abort() end if if (config%i_liq_model == ILiquidModelSOCRATES) then @@ -216,7 +217,7 @@ end subroutine setup_cloud_optics !--------------------------------------------------------------------- ! Compute cloud optical properties subroutine cloud_optics(nlev,istartcol,iendcol, & - & config, thermodynamics, cloud, & + & config, thermodynamics, cloud, & & od_lw_cloud, ssa_lw_cloud, g_lw_cloud, & & od_sw_cloud, ssa_sw_cloud, g_sw_cloud) @@ -232,6 +233,7 @@ subroutine cloud_optics(nlev,istartcol,iendcol, & use radiation_thermodynamics, only : thermodynamics_type use radiation_cloud, only : cloud_type use radiation_constants, only : AccelDueToGravity + use radiation_cloud_optics_data, only : cloud_optics_type use radiation_ice_optics_fu, only : calc_ice_optics_fu_sw, & & calc_ice_optics_fu_lw use radiation_ice_optics_baran, only : calc_ice_optics_baran, & @@ -286,6 +288,10 @@ subroutine cloud_optics(nlev,istartcol,iendcol, & ! path real(jprb) :: factor + ! Pointer to the cloud optics coefficients for brevity of + ! access + type(cloud_optics_type), pointer :: ho + integer :: jcol, jlev, jb real(jphook) :: hook_handle @@ -296,227 +302,244 @@ subroutine cloud_optics(nlev,istartcol,iendcol, & write(nulout,'(a)') 'Computing cloud absorption/scattering properties' end if - associate(ho => config%cloud_optics) + ho => config%cloud_optics - ! Array-wise assignment - od_lw_cloud = 0.0_jprb - od_sw_cloud = 0.0_jprb - ssa_sw_cloud = 0.0_jprb - g_sw_cloud = 0.0_jprb - if (config%do_lw_cloud_scattering) then - ssa_lw_cloud = 0.0_jprb - g_lw_cloud = 0.0_jprb - end if + ! Array-wise assignment + od_lw_cloud = 0.0_jprb + od_sw_cloud = 0.0_jprb + ssa_sw_cloud = 0.0_jprb + g_sw_cloud = 0.0_jprb + if (config%do_lw_cloud_scattering) then + ssa_lw_cloud = 0.0_jprb + g_lw_cloud = 0.0_jprb + end if - do jlev = 1,nlev - do jcol = istartcol,iendcol - ! Only do anything if cloud is present (assume that - ! cloud%crop_cloud_fraction has already been called) - if (cloud%fraction(jcol,jlev) > 0.0_jprb) then - - ! Compute in-cloud liquid and ice water path - if (config%is_homogeneous) then - ! Homogeneous solvers assume cloud fills the box - ! horizontally, so we don't divide by cloud fraction - factor = ( thermodynamics%pressure_hl(jcol,jlev+1) & - & -thermodynamics%pressure_hl(jcol,jlev ) ) & - & / AccelDueToGravity + do jlev = 1,nlev + do jcol = istartcol,iendcol + ! Only do anything if cloud is present (assume that + ! cloud%crop_cloud_fraction has already been called) + if (cloud%fraction(jcol,jlev) > 0.0_jprb) then + + ! Compute in-cloud liquid and ice water path + if (config%is_homogeneous) then + ! Homogeneous solvers assume cloud fills the box + ! horizontally, so we don't divide by cloud fraction + factor = ( thermodynamics%pressure_hl(jcol,jlev+1) & + & -thermodynamics%pressure_hl(jcol,jlev ) ) & + & / AccelDueToGravity + else + factor = ( thermodynamics%pressure_hl(jcol,jlev+1) & + & -thermodynamics%pressure_hl(jcol,jlev ) ) & + & / (AccelDueToGravity * cloud%fraction(jcol,jlev)) + end if + lwp_in_cloud = factor * cloud%q_liq(jcol,jlev) + iwp_in_cloud = factor * cloud%q_ice(jcol,jlev) + + ! Only compute liquid properties if liquid cloud is + ! present + if (lwp_in_cloud > 0.0_jprb) then + if (config%i_liq_model == ILiquidModelSOCRATES) then + ! Compute longwave properties + call calc_liq_optics_socrates(config%n_bands_lw, & + & config%cloud_optics%liq_coeff_lw, & + & lwp_in_cloud, cloud%re_liq(jcol,jlev), & + & od_lw_liq, scat_od_lw_liq, g_lw_liq) + ! Compute shortwave properties + call calc_liq_optics_socrates(config%n_bands_sw, & + & config%cloud_optics%liq_coeff_sw, & + & lwp_in_cloud, cloud%re_liq(jcol,jlev), & + & od_sw_liq, scat_od_sw_liq, g_sw_liq) + else if (config%i_liq_model == ILiquidModelSlingo) then + ! Compute longwave properties + call calc_liq_optics_lindner_li(config%n_bands_lw, & + & config%cloud_optics%liq_coeff_lw, & + & lwp_in_cloud, cloud%re_liq(jcol,jlev), & + & od_lw_liq, scat_od_lw_liq, g_lw_liq) + ! Compute shortwave properties + call calc_liq_optics_slingo(config%n_bands_sw, & + & config%cloud_optics%liq_coeff_sw, & + & lwp_in_cloud, cloud%re_liq(jcol,jlev), & + & od_sw_liq, scat_od_sw_liq, g_sw_liq) + else if (config%i_liq_model == ILiquidModelJahangir) then + ! Compute longwave properties + call calc_liq_optics_socrates(config%n_bands_lw, & + & config%cloud_optics%liq_coeff_lw, & + & lwp_in_cloud, cloud%re_liq(jcol,jlev), & + & od_lw_liq, scat_od_lw_liq, g_lw_liq) + ! Compute shortwave properties + call calc_liq_optics_jahangir(config%n_bands_sw, & + & config%cloud_optics%liq_coeff_sw, & + & lwp_in_cloud, cloud%re_liq(jcol,jlev), & + & od_sw_liq, scat_od_sw_liq, g_sw_liq) + else if (config%i_liq_model == ILiquidModelNielsen) then + ! Compute longwave properties + call calc_liq_optics_socrates(config%n_bands_lw, & + & config%cloud_optics%liq_coeff_lw, & + & lwp_in_cloud, cloud%re_liq(jcol,jlev), & + & od_lw_liq, scat_od_lw_liq, g_lw_liq) + call calc_liq_optics_nielsen(config%n_bands_sw, & + & config%cloud_optics%liq_coeff_sw, & + & lwp_in_cloud, cloud%re_liq(jcol,jlev), & + & od_sw_liq, scat_od_sw_liq, g_sw_liq) else - factor = ( thermodynamics%pressure_hl(jcol,jlev+1) & - & -thermodynamics%pressure_hl(jcol,jlev ) ) & - & / (AccelDueToGravity * cloud%fraction(jcol,jlev)) + write(nulerr,*) '*** Error: Unknown liquid model with code', & + & config%i_liq_model + call radiation_abort() end if - lwp_in_cloud = factor * cloud%q_liq(jcol,jlev) - iwp_in_cloud = factor * cloud%q_ice(jcol,jlev) - - ! Only compute liquid properties if liquid cloud is - ! present - if (lwp_in_cloud > 0.0_jprb) then - if (config%i_liq_model == ILiquidModelSOCRATES) then - ! Compute longwave properties - call calc_liq_optics_socrates(config%n_bands_lw, & - & config%cloud_optics%liq_coeff_lw, & - & lwp_in_cloud, cloud%re_liq(jcol,jlev), & - & od_lw_liq, scat_od_lw_liq, g_lw_liq) - ! Compute shortwave properties - call calc_liq_optics_socrates(config%n_bands_sw, & - & config%cloud_optics%liq_coeff_sw, & - & lwp_in_cloud, cloud%re_liq(jcol,jlev), & - & od_sw_liq, scat_od_sw_liq, g_sw_liq) - else if (config%i_liq_model == ILiquidModelSlingo) then - ! Compute longwave properties - call calc_liq_optics_lindner_li(config%n_bands_lw, & - & config%cloud_optics%liq_coeff_lw, & - & lwp_in_cloud, cloud%re_liq(jcol,jlev), & - & od_lw_liq, scat_od_lw_liq, g_lw_liq) - ! Compute shortwave properties - call calc_liq_optics_slingo(config%n_bands_sw, & - & config%cloud_optics%liq_coeff_sw, & - & lwp_in_cloud, cloud%re_liq(jcol,jlev), & - & od_sw_liq, scat_od_sw_liq, g_sw_liq) - else - write(nulerr,*) '*** Error: Unknown liquid model with code', & - & config%i_liq_model - call radiation_abort() - end if - ! Delta-Eddington scaling in the shortwave only - if (.not. config%do_sw_delta_scaling_with_gases) then - call delta_eddington_scat_od(od_sw_liq, scat_od_sw_liq, g_sw_liq) + ! Delta-Eddington scaling in the shortwave only + if (.not. config%do_sw_delta_scaling_with_gases) then + call delta_eddington_scat_od(od_sw_liq, scat_od_sw_liq, g_sw_liq) + end if + !call delta_eddington_scat_od(od_lw_liq, scat_od_lw_liq, g_lw_liq) + + else + ! Liquid not present: set properties to zero + od_lw_liq = 0.0_jprb + scat_od_lw_liq = 0.0_jprb + g_lw_liq = 0.0_jprb + + od_sw_liq = 0.0_jprb + scat_od_sw_liq = 0.0_jprb + g_sw_liq = 0.0_jprb + end if ! Liquid present + + ! Only compute ice properties if ice cloud is present + if (iwp_in_cloud > 0.0_jprb) then + if (config%i_ice_model == IIceModelBaran) then + ! Compute longwave properties + call calc_ice_optics_baran(config%n_bands_lw, & + & config%cloud_optics%ice_coeff_lw, & + & iwp_in_cloud, cloud%q_ice(jcol,jlev), & + & od_lw_ice, scat_od_lw_ice, g_lw_ice) + ! Compute shortwave properties + call calc_ice_optics_baran(config%n_bands_sw, & + & config%cloud_optics%ice_coeff_sw, & + & iwp_in_cloud, cloud%q_ice(jcol,jlev), & + & od_sw_ice, scat_od_sw_ice, g_sw_ice) + else if (config%i_ice_model == IIceModelBaran2016) then + temperature = 0.5_jprb * (thermodynamics%temperature_hl(jcol,jlev) & + & +thermodynamics%temperature_hl(jcol,jlev+1)) + ! Compute longwave properties + call calc_ice_optics_baran2016(config%n_bands_lw, & + & config%cloud_optics%ice_coeff_lw, & + & iwp_in_cloud, cloud%q_ice(jcol,jlev), & + & temperature, & + & od_lw_ice, scat_od_lw_ice, g_lw_ice) + ! Compute shortwave properties + call calc_ice_optics_baran2016(config%n_bands_sw, & + & config%cloud_optics%ice_coeff_sw, & + & iwp_in_cloud, cloud%q_ice(jcol,jlev), & + & temperature, & + & od_sw_ice, scat_od_sw_ice, g_sw_ice) + else if (config%i_ice_model == IIceModelBaran2017) then + temperature = 0.5_jprb * (thermodynamics%temperature_hl(jcol,jlev) & + & +thermodynamics%temperature_hl(jcol,jlev+1)) + ! Compute longwave properties + call calc_ice_optics_baran2017(config%n_bands_lw, & + & config%cloud_optics%ice_coeff_gen, & + & config%cloud_optics%ice_coeff_lw, & + & iwp_in_cloud, cloud%q_ice(jcol,jlev), & + & temperature, & + & od_lw_ice, scat_od_lw_ice, g_lw_ice) + ! Compute shortwave properties + call calc_ice_optics_baran2017(config%n_bands_sw, & + & config%cloud_optics%ice_coeff_gen, & + & config%cloud_optics%ice_coeff_sw, & + & iwp_in_cloud, cloud%q_ice(jcol,jlev), & + & temperature, & + & od_sw_ice, scat_od_sw_ice, g_sw_ice) + else if (config%i_ice_model == IIceModelFu) then + ! Compute longwave properties + call calc_ice_optics_fu_lw(config%n_bands_lw, & + & config%cloud_optics%ice_coeff_lw, & + & iwp_in_cloud, cloud%re_ice(jcol,jlev), & + & od_lw_ice, scat_od_lw_ice, g_lw_ice) + if (config%do_fu_lw_ice_optics_bug) then + ! Reproduce bug in old IFS scheme + scat_od_lw_ice = od_lw_ice - scat_od_lw_ice end if - ! Originally delta-Eddington has been off in ecRad for - ! liquid clouds in the longwave, but it should be on - !call delta_eddington_scat_od(od_lw_liq, scat_od_lw_liq, g_lw_liq) - + ! Compute shortwave properties + call calc_ice_optics_fu_sw(config%n_bands_sw, & + & config%cloud_optics%ice_coeff_sw, & + & iwp_in_cloud, cloud%re_ice(jcol,jlev), & + & od_sw_ice, scat_od_sw_ice, g_sw_ice) + else if (config%i_ice_model == IIceModelYi) then + ! Compute longwave properties + call calc_ice_optics_yi_lw(config%n_bands_lw, & + & config%cloud_optics%ice_coeff_lw, & + & iwp_in_cloud, cloud%re_ice(jcol,jlev), & + & od_lw_ice, scat_od_lw_ice, g_lw_ice) + ! Compute shortwave properties + call calc_ice_optics_yi_sw(config%n_bands_sw, & + & config%cloud_optics%ice_coeff_sw, & + & iwp_in_cloud, cloud%re_ice(jcol,jlev), & + & od_sw_ice, scat_od_sw_ice, g_sw_ice) else - ! Liquid not present: set properties to zero - od_lw_liq = 0.0_jprb - scat_od_lw_liq = 0.0_jprb - g_lw_liq = 0.0_jprb - - od_sw_liq = 0.0_jprb - scat_od_sw_liq = 0.0_jprb - g_sw_liq = 0.0_jprb - end if ! Liquid present - - ! Only compute ice properties if ice cloud is present - if (iwp_in_cloud > 0.0_jprb) then - if (config%i_ice_model == IIceModelBaran) then - ! Compute longwave properties - call calc_ice_optics_baran(config%n_bands_lw, & - & config%cloud_optics%ice_coeff_lw, & - & iwp_in_cloud, cloud%q_ice(jcol,jlev), & - & od_lw_ice, scat_od_lw_ice, g_lw_ice) - ! Compute shortwave properties - call calc_ice_optics_baran(config%n_bands_sw, & - & config%cloud_optics%ice_coeff_sw, & - & iwp_in_cloud, cloud%q_ice(jcol,jlev), & - & od_sw_ice, scat_od_sw_ice, g_sw_ice) - else if (config%i_ice_model == IIceModelBaran2016) then - temperature = 0.5_jprb * (thermodynamics%temperature_hl(jcol,jlev) & - & +thermodynamics%temperature_hl(jcol,jlev+1)) - ! Compute longwave properties - call calc_ice_optics_baran2016(config%n_bands_lw, & - & config%cloud_optics%ice_coeff_lw, & - & iwp_in_cloud, cloud%q_ice(jcol,jlev), & - & temperature, & - & od_lw_ice, scat_od_lw_ice, g_lw_ice) - ! Compute shortwave properties - call calc_ice_optics_baran2016(config%n_bands_sw, & - & config%cloud_optics%ice_coeff_sw, & - & iwp_in_cloud, cloud%q_ice(jcol,jlev), & - & temperature, & - & od_sw_ice, scat_od_sw_ice, g_sw_ice) - else if (config%i_ice_model == IIceModelBaran2017) then - temperature = 0.5_jprb * (thermodynamics%temperature_hl(jcol,jlev) & - & +thermodynamics%temperature_hl(jcol,jlev+1)) - ! Compute longwave properties - call calc_ice_optics_baran2017(config%n_bands_lw, & - & config%cloud_optics%ice_coeff_gen, & - & config%cloud_optics%ice_coeff_lw, & - & iwp_in_cloud, cloud%q_ice(jcol,jlev), & - & temperature, & - & od_lw_ice, scat_od_lw_ice, g_lw_ice) - ! Compute shortwave properties - call calc_ice_optics_baran2017(config%n_bands_sw, & - & config%cloud_optics%ice_coeff_gen, & - & config%cloud_optics%ice_coeff_sw, & - & iwp_in_cloud, cloud%q_ice(jcol,jlev), & - & temperature, & - & od_sw_ice, scat_od_sw_ice, g_sw_ice) - else if (config%i_ice_model == IIceModelFu) then - ! Compute longwave properties - call calc_ice_optics_fu_lw(config%n_bands_lw, & - & config%cloud_optics%ice_coeff_lw, & - & iwp_in_cloud, cloud%re_ice(jcol,jlev), & - & od_lw_ice, scat_od_lw_ice, g_lw_ice) - if (config%do_fu_lw_ice_optics_bug) then - ! Reproduce bug in old IFS scheme - scat_od_lw_ice = od_lw_ice - scat_od_lw_ice - end if - ! Compute shortwave properties - call calc_ice_optics_fu_sw(config%n_bands_sw, & - & config%cloud_optics%ice_coeff_sw, & - & iwp_in_cloud, cloud%re_ice(jcol,jlev), & - & od_sw_ice, scat_od_sw_ice, g_sw_ice) - else if (config%i_ice_model == IIceModelYi) then - ! Compute longwave properties - call calc_ice_optics_yi_lw(config%n_bands_lw, & - & config%cloud_optics%ice_coeff_lw, & - & iwp_in_cloud, cloud%re_ice(jcol,jlev), & - & od_lw_ice, scat_od_lw_ice, g_lw_ice) - ! Compute shortwave properties - call calc_ice_optics_yi_sw(config%n_bands_sw, & - & config%cloud_optics%ice_coeff_sw, & - & iwp_in_cloud, cloud%re_ice(jcol,jlev), & - & od_sw_ice, scat_od_sw_ice, g_sw_ice) - else - write(nulerr,*) '*** Error: Unknown ice model with code', & - & config%i_ice_model - call radiation_abort() - end if - - ! Delta-Eddington scaling in both longwave and shortwave - ! (assume that particles are larger than wavelength even - ! in longwave) - if (.not. config%do_sw_delta_scaling_with_gases) then - call delta_eddington_scat_od(od_sw_ice, scat_od_sw_ice, g_sw_ice) - end if - call delta_eddington_scat_od(od_lw_ice, scat_od_lw_ice, g_lw_ice) + write(nulerr,*) '*** Error: Unknown ice model with code', & + & config%i_ice_model + call radiation_abort() + end if - else - ! Ice not present: set properties to zero - od_lw_ice = 0.0_jprb - scat_od_lw_ice = 0.0_jprb - g_lw_ice = 0.0_jprb - - od_sw_ice = 0.0_jprb - scat_od_sw_ice = 0.0_jprb - g_sw_ice = 0.0_jprb - end if ! Ice present - - ! Combine liquid and ice - if (config%do_lw_cloud_scattering) then - ! Added for DWD (2020) - !NEC$ shortloop - do jb = 1, config%n_bands_lw - od_lw_cloud(jb,jlev,jcol) = od_lw_liq(jb) + od_lw_ice(jb) - if (scat_od_lw_liq(jb)+scat_od_lw_ice(jb) > 0.0_jprb) then - g_lw_cloud(jb,jlev,jcol) = (g_lw_liq(jb) * scat_od_lw_liq(jb) & - & + g_lw_ice(jb) * scat_od_lw_ice(jb)) & - & / (scat_od_lw_liq(jb)+scat_od_lw_ice(jb)) - else - g_lw_cloud(jb,jlev,jcol) = 0.0_jprb - end if - ssa_lw_cloud(jb,jlev,jcol) = (scat_od_lw_liq(jb) + scat_od_lw_ice(jb)) & - & / (od_lw_liq(jb) + od_lw_ice(jb)) - end do - else - ! If longwave scattering is to be neglected then the - ! best approximation is to set the optical depth equal - ! to the absorption optical depth - ! Added for DWD (2020) - !NEC$ shortloop - do jb = 1, config%n_bands_lw - od_lw_cloud(jb,jlev,jcol) = od_lw_liq(jb) - scat_od_lw_liq(jb) & - & + od_lw_ice(jb) - scat_od_lw_ice(jb) - end do + ! Delta-Eddington scaling in both longwave and shortwave + ! (assume that particles are larger than wavelength even + ! in longwave) + if (.not. config%do_sw_delta_scaling_with_gases) then + call delta_eddington_scat_od(od_sw_ice, scat_od_sw_ice, g_sw_ice) end if - ! Added for DWD (2020) - !NEC$ shortloop - do jb = 1, config%n_bands_sw - od_sw_cloud(jb,jlev,jcol) = od_sw_liq(jb) + od_sw_ice(jb) - g_sw_cloud(jb,jlev,jcol) = (g_sw_liq(jb) * scat_od_sw_liq(jb) & - & + g_sw_ice(jb) * scat_od_sw_ice(jb)) & - & / (scat_od_sw_liq(jb) + scat_od_sw_ice(jb)) - ssa_sw_cloud(jb,jlev,jcol) & - & = (scat_od_sw_liq(jb) + scat_od_sw_ice(jb)) / (od_sw_liq(jb) + od_sw_ice(jb)) + call delta_eddington_scat_od(od_lw_ice, scat_od_lw_ice, g_lw_ice) + + else + ! Ice not present: set properties to zero + od_lw_ice = 0.0_jprb + scat_od_lw_ice = 0.0_jprb + g_lw_ice = 0.0_jprb + + od_sw_ice = 0.0_jprb + scat_od_sw_ice = 0.0_jprb + g_sw_ice = 0.0_jprb + end if ! Ice present + + ! Combine liquid and ice + if (config%do_lw_cloud_scattering) then +! Added for DWD (2020) +!NEC$ shortloop + do jb = 1, config%n_bands_lw + od_lw_cloud(jb,jlev,jcol) = od_lw_liq(jb) + od_lw_ice(jb) + if (scat_od_lw_liq(jb)+scat_od_lw_ice(jb) > 0.0_jprb) then + g_lw_cloud(jb,jlev,jcol) = (g_lw_liq(jb) * scat_od_lw_liq(jb) & + & + g_lw_ice(jb) * scat_od_lw_ice(jb)) & + & / (scat_od_lw_liq(jb)+scat_od_lw_ice(jb)) + else + g_lw_cloud(jb,jlev,jcol) = 0.0_jprb + end if + ssa_lw_cloud(jb,jlev,jcol) = (scat_od_lw_liq(jb) + scat_od_lw_ice(jb)) & + & / (od_lw_liq(jb) + od_lw_ice(jb)) end do - end if ! Cloud present - end do ! Loop over column - end do ! Loop over level - - end associate + else + ! If longwave scattering is to be neglected then the + ! best approximation is to set the optical depth equal + ! to the absorption optical depth +! Added for DWD (2020) +!NEC$ shortloop + do jb = 1, config%n_bands_lw + od_lw_cloud(jb,jlev,jcol) = od_lw_liq(jb) - scat_od_lw_liq(jb) & + & + od_lw_ice(jb) - scat_od_lw_ice(jb) + end do + end if +! Added for DWD (2020) +!NEC$ shortloop + do jb = 1, config%n_bands_sw + od_sw_cloud(jb,jlev,jcol) = od_sw_liq(jb) + od_sw_ice(jb) + g_sw_cloud(jb,jlev,jcol) = (g_sw_liq(jb) * scat_od_sw_liq(jb) & + & + g_sw_ice(jb) * scat_od_sw_ice(jb)) & + & / (scat_od_sw_liq(jb) + scat_od_sw_ice(jb)) + ssa_sw_cloud(jb,jlev,jcol) & + & = (scat_od_sw_liq(jb) + scat_od_sw_ice(jb)) / (od_sw_liq(jb) + od_sw_ice(jb)) + end do + end if ! Cloud present + end do ! Loop over column + end do ! Loop over level if (lhook) call dr_hook('radiation_cloud_optics:cloud_optics',1,hook_handle) diff --git a/radiation/radiation_cloud_optics_data.F90 b/radiation/radiation_cloud_optics_data.F90 index c4f8ce4b..4f66a4f9 100644 --- a/radiation/radiation_cloud_optics_data.F90 +++ b/radiation/radiation_cloud_optics_data.F90 @@ -13,8 +13,6 @@ ! Email: r.j.hogan@ecmwf.int ! -#include "ecrad_config.h" - module radiation_cloud_optics_data use parkind1, only : jprb @@ -47,14 +45,11 @@ module radiation_cloud_optics_data !--------------------------------------------------------------------- ! Setup cloud optics coefficients by reading them from a file - subroutine setup_cloud_optics(this, liq_file_name, ice_file_name, iverbose) + subroutine setup_cloud_optics(this, liq_file_name, ice_file_name, & + & iverbose) - use yomhook, only : lhook, dr_hook, jphook -#ifdef EASY_NETCDF_READ_MPI + use yomhook, only : lhook, dr_hook, jphook use easy_netcdf_read_mpi, only : netcdf_file -#else - use easy_netcdf, only : netcdf_file -#endif class(cloud_optics_type), intent(inout) :: this character(len=*), intent(in) :: liq_file_name, ice_file_name @@ -63,7 +58,7 @@ subroutine setup_cloud_optics(this, liq_file_name, ice_file_name, iverbose) ! The NetCDF file containing the coefficients type(netcdf_file) :: file integer :: iverb - real(jphook) :: hook_handle + real(jphook) :: hook_handle if (lhook) call dr_hook('radiation_cloud_optics_data:setup',0,hook_handle) diff --git a/radiation/radiation_cloudless_lw.F90 b/radiation/radiation_cloudless_lw.F90 index 78b93c48..781483b1 100644 --- a/radiation/radiation_cloudless_lw.F90 +++ b/radiation/radiation_cloudless_lw.F90 @@ -1,5 +1,3 @@ -! radiation_cloudless_lw.F90 - Longwave homogeneous cloudless solver -! ! (C) Copyright 2019- ECMWF. ! ! This software is licensed under the terms of the Apache Licence Version 2.0 @@ -8,6 +6,8 @@ ! In applying this licence, ECMWF does not waive the privileges and immunities ! granted to it by virtue of its status as an intergovernmental organisation ! nor does it submit to any jurisdiction. + +! radiation_cloudless_lw.F90 - Longwave homogeneous cloudless solver ! ! Author: Robin Hogan ! Email: r.j.hogan@ecmwf.int @@ -52,7 +52,7 @@ subroutine solver_cloudless_lw(nlev,istartcol,iendcol, & ! Planck function at each half-level and the surface real(jprb), intent(in), dimension(config%n_g_lw,nlev+1,istartcol:iendcol) :: & & planck_hl - + ! Emission (Planck*emissivity) and albedo (1-emissivity) at the ! surface at each longwave g-point real(jprb), intent(in), dimension(config%n_g_lw, istartcol:iendcol) & @@ -116,7 +116,7 @@ subroutine solver_cloudless_lw(nlev,istartcol,iendcol, & ! transmission and emission call calc_no_scattering_transmittance_lw(ng, od(:,jlev,jcol), & & planck_hl(:,jlev,jcol), planck_hl(:,jlev+1, jcol), & - & transmittance(:,jlev), source_up(:,jlev), source_dn(:,jlev)) + & transmittance(:,jlev), source_up(:,jlev), source_dn(:,jlev)) ! Ensure that clear-sky reflectance is zero reflectance(:,jlev) = 0.0_jprb end if @@ -134,7 +134,7 @@ subroutine solver_cloudless_lw(nlev,istartcol,iendcol, & & transmittance, source_up, source_dn, & & emission(:,jcol), albedo(:,jcol), & & flux_up, flux_dn) - + end if ! Sum over g-points to compute broadband fluxes @@ -173,7 +173,7 @@ subroutine solver_cloudless_lw(nlev,istartcol,iendcol, & end do if (lhook) call dr_hook('radiation_cloudless_lw:solver_cloudless_lw',1,hook_handle) - + end subroutine solver_cloudless_lw end module radiation_cloudless_lw diff --git a/radiation/radiation_cloudless_sw.F90 b/radiation/radiation_cloudless_sw.F90 index d26793be..2ac1488e 100644 --- a/radiation/radiation_cloudless_sw.F90 +++ b/radiation/radiation_cloudless_sw.F90 @@ -1,5 +1,3 @@ -! radiation_cloudless_sw.F90 - Shortwave homogeneous cloudless solver -! ! (C) Copyright 2019- ECMWF. ! ! This software is licensed under the terms of the Apache Licence Version 2.0 @@ -8,6 +6,8 @@ ! In applying this licence, ECMWF does not waive the privileges and immunities ! granted to it by virtue of its status as an intergovernmental organisation ! nor does it submit to any jurisdiction. + +! radiation_cloudless_sw.F90 - Shortwave homogeneous cloudless solver ! ! Author: Robin Hogan ! Email: r.j.hogan@ecmwf.int @@ -25,7 +25,7 @@ module radiation_cloudless_sw !--------------------------------------------------------------------- ! Shortwave homogeneous solver containing no clouds subroutine solver_cloudless_sw(nlev,istartcol,iendcol, & - & config, single_level, & + & config, single_level, & & od, ssa, g, albedo_direct, albedo_diffuse, incoming_sw, & & flux) @@ -107,7 +107,7 @@ subroutine solver_cloudless_sw(nlev,istartcol,iendcol, & if (single_level%cos_sza(jcol) > 0.0_jprb) then cos_sza = single_level%cos_sza(jcol) - + ! The following is the same as the clear-sky part of ! solver_homogeneous_sw if (.not. config%do_sw_delta_scaling_with_gases) then @@ -143,13 +143,13 @@ subroutine solver_cloudless_sw(nlev,istartcol,iendcol, & & trans_dir_dir(:,jlev) ) end do end if - + ! Use adding method to compute fluxes call adding_ica_sw(ng, nlev, incoming_sw(:,jcol), & & albedo_diffuse(:,jcol), albedo_direct(:,jcol), & & spread(cos_sza,1,ng), reflectance, transmittance, ref_dir, trans_dir_diff, & & trans_dir_dir, flux_up, flux_dn_diffuse, flux_dn_direct) - + ! Sum over g-points to compute and save clear-sky broadband ! fluxes flux%sw_up(jcol,:) = sum(flux_up,1) diff --git a/radiation/radiation_config.F90 b/radiation/radiation_config.F90 index c1b9b6bb..52e23149 100644 --- a/radiation/radiation_config.F90 +++ b/radiation/radiation_config.F90 @@ -33,8 +33,6 @@ ! files in this directory, please inform Robin Hogan. ! -#include "ecrad_config.h" - module radiation_config use parkind1, only : jprb @@ -56,9 +54,9 @@ module radiation_config ! Solvers: can be specified for longwave and shortwave ! independently, except for "Homogeneous", which must be the same ! for both - enum, bind(c) + enum, bind(c) enumerator ISolverCloudless, ISolverHomogeneous, ISolverMcICA, & - & ISolverSpartacus, ISolverTripleclouds + & ISolverSpartacus, ISolverTripleclouds end enum character(len=*), parameter :: SolverName(0:4) = (/ 'Cloudless ', & & 'Homogeneous ', & @@ -68,7 +66,7 @@ module radiation_config ! SPARTACUS shortwave solver can treat the reflection of radiation ! back up into different regions in various ways - enum, bind(c) + enum, bind(c) enumerator & & IEntrapmentZero, & ! No entrapment, as Tripleclouds & IEntrapmentEdgeOnly, & ! Only radiation passed through cloud edge is horizontally homogenized @@ -76,7 +74,7 @@ module radiation_config & IEntrapmentExplicitNonFractal, & ! As above but ignore fractal nature of clouds & IEntrapmentMaximum ! Complete horizontal homogenization within regions (old SPARTACUS assumption) end enum - + ! Names available in the radiation namelist for variable ! sw_entrapment_name character(len=*), parameter :: EntrapmentName(0:4) = [ 'Zero ', & @@ -97,15 +95,15 @@ module radiation_config ! This is not configurable at run-time ! Gas models - enum, bind(c) + enum, bind(c) enumerator IGasModelMonochromatic, IGasModelIFSRRTMG, IGasModelECCKD end enum character(len=*), parameter :: GasModelName(0:2) = (/ 'Monochromatic', & & 'RRTMG-IFS ', & & 'ECCKD '/) - ! Liquid cloud optics models for use with RRTMG gas optics - enum, bind(c) + ! Hydrometeor scattering models + enum, bind(c) enumerator ILiquidModelMonochromatic, & & ILiquidModelSOCRATES, ILiquidModelSlingo, & & ILiquidModelJahangir, ILiquidModelNielsen @@ -116,21 +114,17 @@ module radiation_config & 'Jahangir ', & & 'Nielsen ' /) - ! Ice optics models for use with RRTMG gas optics. Note that of the - ! "Baran" parameterizations, only Baran2016 is published (Baran, - ! J. Climate, 2016) - the others are experimental and not - ! recommended. - enum, bind(c) + enum, bind(c) enumerator IIceModelMonochromatic, IIceModelFu, & & IIceModelBaran, IIceModelBaran2016, IIceModelBaran2017, & & IIceModelYi end enum - character(len=*), parameter :: IceModelName(0:5) = (/ 'Monochromatic ', & - & 'Fu-IFS ', & - & 'Baran-EXPERIMENTAL ', & - & 'Baran2016 ', & - & 'Baran2017-EXPERIMENTAL', & - & 'Yi ' /) + character(len=*), parameter :: IceModelName(0:5) = (/ 'Monochromatic', & + & 'Fu-IFS ', & + & 'Baran ', & + & 'Baran2016 ', & + & 'Baran2017 ', & + & 'Yi ' /) ! Cloud PDF distribution shapes enum, bind(c) @@ -172,7 +166,7 @@ module radiation_config ! phase of the solar cycle, via scalar ! single_level%spectral_solar_cycle_multiplier logical :: use_spectral_solar_cycle = .false. - + ! Directory in which gas, cloud and aerosol data files are to be ! found character(len=511) :: directory_name = '.' @@ -206,7 +200,7 @@ module radiation_config ! Use a more vectorizable McICA cloud generator, at the expense of ! more random numbers being generated? This is the default on NEC ! SX. -#ifdef DWD_VECTOR_OPTIMIZATIONS +#ifdef __SX__ logical :: use_vectorizable_generator = .true. #else logical :: use_vectorizable_generator = .false. @@ -280,8 +274,7 @@ module radiation_config logical :: do_sw_delta_scaling_with_gases = .false. ! Codes describing the gas model - integer :: i_gas_model_sw = IGasModelIFSRRTMG - integer :: i_gas_model_lw = IGasModelIFSRRTMG + integer :: i_gas_model = IGasModelIFSRRTMG ! Optics if i_gas_model==IGasModelMonochromatic. ! The wavelength to use for the Planck function in metres. If this @@ -306,7 +299,7 @@ module radiation_config ! Codes describing particle scattering models integer :: i_liq_model = ILiquidModelSOCRATES integer :: i_ice_model = IIceModelBaran - + ! The mapping from albedo/emissivity intervals to SW/LW bands can ! either be done by finding the interval containing the central ! wavenumber of the band (nearest neighbour), or by a weighting @@ -339,7 +332,7 @@ module radiation_config ! Do we include 3D effects? logical :: do_3d_effects = .true. - + character(len=511) :: cloud_type_name(NMaxCloudTypes) = ["","","","","","","","","","","",""] ! & ! & = ["mie_droplet ", & @@ -494,7 +487,7 @@ module radiation_config ! irradiance in each g point? Only possible if ! use_spectral_solar_cycle==true. logical :: use_updated_solar_spectrum = .false. - + ! Optionally override the look-up table file for the cloud-water ! PDF used by the McICA solver character(len=511) :: cloud_pdf_override_file_name = '' @@ -515,7 +508,7 @@ module radiation_config ! Users of this library should not edit these parameters directly; ! they are set by the "consolidate" routine - ! Has "consolidate" been called? + ! Has "consolidate" been called? logical :: is_consolidated = .false. ! Fraction of each g point in each wavenumber interval, @@ -600,7 +593,7 @@ module radiation_config ! Solar spectral irradiance file name character(len=511) :: ssi_file_name - + ! McICA PDF look-up table file name character(len=511) :: cloud_pdf_file_name @@ -639,7 +632,6 @@ module radiation_config procedure :: print => print_config procedure :: get_sw_weights procedure :: get_sw_mapping - procedure :: get_uv_biological_weights procedure :: define_sw_albedo_intervals procedure :: define_lw_emiss_intervals procedure :: set_aerosol_wavelength_mono @@ -676,7 +668,7 @@ subroutine read_config_from_namelist(this, file_name, unit, is_success) ! The following variables are read from the namelists and map ! directly onto members of the config_type derived type - ! To be read from the radiation_config namelist + ! To be read from the radiation_config namelist logical :: do_sw, do_lw, do_clear, do_sw_direct logical :: do_3d_effects, use_expm_everywhere, use_aerosols logical :: use_general_cloud_optics, use_general_aerosol_optics @@ -708,7 +700,6 @@ subroutine read_config_from_namelist(this, file_name, unit, is_success) character(511) :: gas_optics_sw_override_file_name, gas_optics_lw_override_file_name character(511) :: ssi_override_file_name character(63) :: liquid_model_name, ice_model_name, gas_model_name - character(63) :: sw_gas_model_name, lw_gas_model_name character(63) :: sw_solver_name, lw_solver_name, overlap_scheme_name character(63) :: sw_entrapment_name, sw_encroachment_name, cloud_pdf_shape_name character(len=511) :: cloud_type_name(NMaxCloudTypes) = ["","","","","","","","","","","",""] @@ -723,7 +714,6 @@ subroutine read_config_from_namelist(this, file_name, unit, is_success) real(jprb) :: lw_emiss_wavelength_bound( NMaxAlbedoIntervals-1) integer :: i_sw_albedo_index(NMaxAlbedoIntervals) integer :: i_lw_emiss_index (NMaxAlbedoIntervals) - integer :: i_gas_model integer :: iunit ! Unit number of namelist file @@ -734,7 +724,7 @@ subroutine read_config_from_namelist(this, file_name, unit, is_success) & do_save_spectral_flux, do_save_gpoint_flux, & & do_surface_sw_spectral_flux, do_lw_derivatives, do_toa_spectral_flux, & & do_lw_aerosol_scattering, do_lw_cloud_scattering, & - & n_regions, directory_name, gas_model_name, sw_gas_model_name, lw_gas_model_name, & + & n_regions, directory_name, gas_model_name, & & ice_optics_override_file_name, liq_optics_override_file_name, & & aerosol_optics_override_file_name, cloud_pdf_override_file_name, & & gas_optics_sw_override_file_name, gas_optics_lw_override_file_name, & @@ -762,12 +752,12 @@ subroutine read_config_from_namelist(this, file_name, unit, is_success) & do_cloud_aerosol_per_lw_g_point, & & do_cloud_aerosol_per_sw_g_point, do_weighted_surface_mapping, & & use_spectral_solar_scaling, use_spectral_solar_cycle, use_updated_solar_spectrum - + real(jphook) :: hook_handle if (lhook) call dr_hook('radiation_config:read',0,hook_handle) - ! Copy default values from the original structure + ! Copy default values from the original structure do_sw = this%do_sw do_lw = this%do_lw do_sw_direct = this%do_sw_direct @@ -823,8 +813,6 @@ subroutine read_config_from_namelist(this, file_name, unit, is_success) overhang_factor = this%overhang_factor encroachment_scaling = -1.0_jprb gas_model_name = '' !DefaultGasModelName - sw_gas_model_name = '' !DefaultGasModelName - lw_gas_model_name = '' !DefaultGasModelName liquid_model_name = '' !DefaultLiquidModelName ice_model_name = '' !DefaultIceModelName sw_solver_name = '' !DefaultSwSolverName @@ -1024,19 +1012,9 @@ subroutine read_config_from_namelist(this, file_name, unit, is_success) call get_enum_code(ice_model_name, IceModelName, & & 'ice_model_name', this%i_ice_model) - ! Determine gas optics model(s) - firstly try the generic gas_model_name - i_gas_model = -1 + ! Determine gas optics model call get_enum_code(gas_model_name, GasModelName, & - & 'gas_model_name', i_gas_model) - if (i_gas_model > -1) then - this%i_gas_model_sw = i_gas_model - this%i_gas_model_lw = i_gas_model - end if - ! ...then the band-specific values - call get_enum_code(sw_gas_model_name, GasModelName, & - & 'sw_gas_model_name', this%i_gas_model_sw) - call get_enum_code(lw_gas_model_name, GasModelName, & - & 'lw_gas_model_name', this%i_gas_model_lw) + & 'gas_model_name', this%i_gas_model) ! Determine solvers call get_enum_code(sw_solver_name, SolverName, & @@ -1056,8 +1034,8 @@ subroutine read_config_from_namelist(this, file_name, unit, is_success) ! Determine overlap scheme call get_enum_code(overlap_scheme_name, OverlapName, & & 'overlap_scheme_name', this%i_overlap_scheme) - - ! Determine cloud PDF shape + + ! Determine cloud PDF shape call get_enum_code(cloud_pdf_shape_name, PdfShapeName, & & 'cloud_pdf_shape_name', this%i_cloud_pdf_shape) @@ -1075,14 +1053,14 @@ subroutine read_config_from_namelist(this, file_name, unit, is_success) this%do_clouds = .false. end if - if (this%use_general_cloud_optics .or. this%use_general_aerosol_optics) then - if (this%do_sw .and. this%do_cloud_aerosol_per_sw_g_point & - & .and. this%i_gas_model_sw == IGasModelIFSRRTMG) then + if (this%i_gas_model == IGasModelIFSRRTMG & + & .and. (this%use_general_cloud_optics & + & .or. this%use_general_aerosol_optics)) then + if (this%do_sw .and. this%do_cloud_aerosol_per_sw_g_point) then write(nulout,'(a)') 'Warning: RRTMG SW only supports cloud/aerosol/surface optical properties per band, not per g-point' this%do_cloud_aerosol_per_sw_g_point = .false. end if - if (this%do_lw .and. this%do_cloud_aerosol_per_lw_g_point & - & .and. this%i_gas_model_lw == IGasModelIFSRRTMG) then + if (this%do_lw .and. this%do_cloud_aerosol_per_lw_g_point) then write(nulout,'(a)') 'Warning: RRTMG LW only supports cloud/aerosol/surface optical properties per band, not per g-point' this%do_cloud_aerosol_per_lw_g_point = .false. end if @@ -1148,21 +1126,19 @@ subroutine consolidate_config(this) end if ! If ecCKD gas optics model is being used set relevant file names - if (this%i_gas_model_sw == IGasModelECCKD .or. this%i_gas_model_lw == IGasModelECCKD) then + if (this%i_gas_model == IGasModelECCKD) then - ! This gas optics model usually used with general cloud and + ! This gas optics model requires the general cloud and ! aerosol optics settings if (.not. this%use_general_cloud_optics) then - write(nulout,'(a)') 'Warning: ecCKD gas optics model usually used with general cloud optics' + write(nulerr,'(a)') '*** Error: ecCKD gas optics model requires general cloud optics' + call radiation_abort('Radiation configuration error') end if if (.not. this%use_general_aerosol_optics) then - write(nulout,'(a)') 'Warning: ecCKD gas optics model usually used with general aerosol optics' + write(nulerr,'(a)') '*** Error: ecCKD gas optics model requires general aerosol optics' + call radiation_abort('Radiation configuration error') end if - end if - - if (this%i_gas_model_sw == IGasModelECCKD) then - if (len_trim(this%gas_optics_sw_override_file_name) > 0) then if (this%gas_optics_sw_override_file_name(1:1) == '/') then this%gas_optics_sw_file_name = trim(this%gas_optics_sw_override_file_name) @@ -1174,13 +1150,9 @@ subroutine consolidate_config(this) ! In the IFS, the gas optics files should be specified in ! ifs/module/radiation_setup.F90, not here this%gas_optics_sw_file_name = trim(this%directory_name) & - & // "/ecckd-1.4_sw_climate_rgb-32b_ckd-definition.nc" + & // "/ecckd-1.0_sw_climate_rgb-32b_ckd-definition.nc" end if - end if - - if (this%i_gas_model_lw == IGasModelECCKD) then - if (len_trim(this%gas_optics_lw_override_file_name) > 0) then if (this%gas_optics_lw_override_file_name(1:1) == '/') then this%gas_optics_lw_file_name = trim(this%gas_optics_lw_override_file_name) @@ -1198,7 +1170,7 @@ subroutine consolidate_config(this) end if if (this%use_spectral_solar_cycle) then - if (this%i_gas_model_sw /= IGasModelECCKD) then + if (this%i_gas_model /= IGasModelECCKD) then write(nulerr,'(a)') '*** Error: solar cycle only available with ecCKD gas optics model' call radiation_abort('Radiation configuration error') else @@ -1216,7 +1188,7 @@ subroutine consolidate_config(this) end if end if end if - + ! Set aerosol optics file name if (len_trim(this%aerosol_optics_override_file_name) > 0) then if (this%aerosol_optics_override_file_name(1:1) == '/') then @@ -1230,7 +1202,7 @@ subroutine consolidate_config(this) ! ifs/module/radiation_setup.F90, not here if (this%use_general_aerosol_optics) then this%aerosol_optics_file_name & - & = trim(this%directory_name) // "/aerosol_ifs_49R1_20230119.nc" + & = trim(this%directory_name) // "/aerosol_ifs_48R1.nc" else this%aerosol_optics_file_name & & = trim(this%directory_name) // "/aerosol_ifs_rrtm_46R1_with_NI_AM.nc" @@ -1312,26 +1284,16 @@ subroutine consolidate_config(this) end if end if - if (this%i_gas_model_sw == IGasModelMonochromatic .or. this%i_gas_model_lw == IGasModelMonochromatic) then - - if (this%i_gas_model_sw /= this%i_gas_model_lw) then - write(nulerr,'(a,i0)') '*** Error: Monochromatic gas optics model must be used in shortwave and longwave' - call radiation_abort('Radiation configuration error') - end if - - ! In the monochromatic case we need to override the liquid, ice - ! and aerosol models to ensure compatibility + ! In the monochromatic case we need to override the liquid, ice + ! and aerosol models to ensure compatibility + if (this%i_gas_model == IGasModelMonochromatic) then this%i_liq_model = ILiquidModelMonochromatic this%i_ice_model = IIceModelMonochromatic this%use_aerosols = .false. - end if ! McICA solver currently can't store full profiles of spectral fluxes if (this%i_solver_sw == ISolverMcICA) then - if (this%iverbosesetup >= 1) then - write(nulout, '(a)') 'Warning: McICA solver cannot store full profiles of spectral fluxes' - end if this%do_save_spectral_flux = .false. end if @@ -1435,10 +1397,8 @@ subroutine print_config(this, iverbose) & 'do_save_radiative_properties', this%do_save_radiative_properties) call print_logical(' Saving spectral flux profiles', & & 'do_save_spectral_flux', this%do_save_spectral_flux) - call print_enum(' Shortwave gas model is', GasModelName, 'i_gas_model_sw', & - & this%i_gas_model_sw) - call print_enum(' Longwave gas model is', GasModelName, 'i_gas_model_lw', & - & this%i_gas_model_lw) + call print_enum(' Gas model is', GasModelName, 'i_gas_model', & + & this%i_gas_model) call print_logical(' Aerosols are', 'use_aerosols', this%use_aerosols) if (this%use_aerosols) then call print_logical(' General aerosol optics', & @@ -1463,7 +1423,7 @@ subroutine print_config(this, iverbose) call print_logical(' Scale spectral solar irradiance', & & 'use_spectral_solar_scaling', this%use_spectral_solar_scaling) end if - + !--------------------------------------------------------------------- write(nulout, '(a)') 'Surface and top-of-atmosphere settings:' call print_logical(' Saving top-of-atmosphere spectral fluxes', & @@ -1525,8 +1485,8 @@ subroutine print_config(this, iverbose) if (this%do_sw) then call print_enum(' Shortwave solver is', SolverName, & & 'i_solver_sw', this%i_solver_sw) - - if (this%i_gas_model_sw == IGasModelMonochromatic) then + + if (this%i_gas_model == IGasModelMonochromatic) then call print_real(' Shortwave atmospheric optical depth', & & 'mono_sw_total_od', this%mono_sw_total_od) call print_real(' Shortwave particulate single-scattering albedo', & @@ -1547,7 +1507,7 @@ subroutine print_config(this, iverbose) call print_enum(' Longwave solver is', SolverName, 'i_solver_lw', & & this%i_solver_lw) - if (this%i_gas_model_lw == IGasModelMonochromatic) then + if (this%i_gas_model == IGasModelMonochromatic) then if (this%mono_lw_wavelength > 0.0_jprb) then call print_real(' Longwave effective wavelength (m)', & & 'mono_lw_wavelength', this%mono_lw_wavelength) @@ -1555,7 +1515,7 @@ subroutine print_config(this, iverbose) write(nulout,'(a)') ' Longwave fluxes are broadband (mono_lw_wavelength<=0)' end if call print_real(' Longwave atmospheric optical depth', & - & 'mono_lw_total_od', this%mono_lw_total_od) + & 'mono_lw_total_od', this%mono_lw_total_od) call print_real(' Longwave particulate single-scattering albedo', & & 'mono_lw_single_scattering_albedo', & & this%mono_lw_single_scattering_albedo) @@ -1608,9 +1568,9 @@ subroutine print_config(this, iverbose) call print_logical(' Use vectorizable McICA cloud generator', & & 'use_vectorizable_generator', this%use_vectorizable_generator) end if - + end if - + end subroutine print_config @@ -1627,6 +1587,7 @@ end subroutine print_config subroutine get_sw_weights(this, wavelength1, wavelength2, & & nweights, iband, weight, weighting_name) + use parkind1, only : jprb use radiation_io, only : nulout, nulerr, radiation_abort use radiation_spectral_definition, only : SolarReferenceTemperature @@ -1700,41 +1661,7 @@ subroutine get_sw_weights(this, wavelength1, wavelength2, & end subroutine get_sw_weights - !--------------------------------------------------------------------- - ! Get weights per g-point to compute the UV biologically effective - ! flux, which should be divided by 40 to obtain UV index. - subroutine get_uv_biological_weights(this, nweights, ig, weight) - - class(config_type), intent(in) :: this - ! Number of output weights - integer, intent(out) :: nweights - ! Index of non-zero g-points and weights of those g-points: user - ! expected to provide arrays of at least ng elements - integer, intent(out) :: ig(:) - real(jprb), intent(out) :: weight(:) - - ! Weights at every g point (only non-zero weights are returned) - real(jprb) :: weight_g(this%gas_optics_sw%spectral_def%ng) - - integer :: jg - - ! McKinlay & Diffey (CIE research note, 1987), but considering any - ! wavelength less than 298 nm to have a weight of 1 (rather than - ! only 250-298 nm) - weight_g = this%gas_optics_sw%spectral_def%weighted_mapping([1.0e-9_jprb, 298.0e-9_jprb, 328.0e-9_jprb, 400.0e-9_jprb], & - & [1.0_jprb, 1.0_jprb, 0.0015136_jprb, 0.0001216_jprb], & - & do_logarithmic=.true.) - nweights = 0 - do jg = 1,this%gas_optics_sw%spectral_def%ng - if (weight_g(jg) > 0.0_jprb) then - nweights = nweights + 1 - ig(nweights) = jg - weight(nweights) = weight_g(jg) - end if - end do - - end subroutine get_uv_biological_weights - + !--------------------------------------------------------------------- ! As get_sw_weights but suitable for a larger number of spectral ! diagnostics at once: a set of monotonically increasing wavelength @@ -1747,6 +1674,7 @@ end subroutine get_uv_biological_weights ! provided on nulout. subroutine get_sw_mapping(this, wavelength_bound, mapping, weighting_name) + use parkind1, only : jprb use radiation_io, only : nulout, nulerr, radiation_abort use radiation_spectral_definition, only : SolarReferenceTemperature @@ -1760,9 +1688,9 @@ subroutine get_sw_mapping(this, wavelength_bound, mapping, weighting_name) integer, allocatable :: diag_ind(:) integer :: ninterval - + integer :: jint ! Loop for interval - + if (this%n_bands_sw <= 0) then write(nulerr,'(a)') '*** Error: get_sw_mapping called before number of shortwave bands set' call radiation_abort('Radiation configuration error') @@ -1774,7 +1702,7 @@ subroutine get_sw_mapping(this, wavelength_bound, mapping, weighting_name) do jint = 1,ninterval+2 diag_ind(jint) = jint end do - + call this%gas_optics_sw%spectral_def%calc_mapping_from_bands( & & wavelength_bound, diag_ind, mapping_local, & & use_bands=(.not. this%do_cloud_aerosol_per_sw_g_point), use_fluxes=.false.) @@ -1797,7 +1725,7 @@ subroutine get_sw_mapping(this, wavelength_bound, mapping, weighting_name) & wavelength_bound(1)*1.0e6_jprb, ' um and ', wavelength_bound(ninterval+1)*1.0e6_jprb, ' um' end if end if - + end subroutine get_sw_mapping @@ -1807,7 +1735,7 @@ end subroutine get_sw_mapping ! scheme. We assume that the input albedo is defined within ! "ninterval" spectral intervals covering the wavelength range 0 to ! infinity, but allow for the possibility that two intervals may be - ! indexed back to the same albedo band. + ! indexed back to the same albedo band. subroutine define_sw_albedo_intervals(this, ninterval, wavelength_bound, & & i_intervals, do_nearest) @@ -1824,7 +1752,7 @@ subroutine define_sw_albedo_intervals(this, ninterval, wavelength_bound, & ! The albedo indices corresponding to each interval integer, intent(in) :: i_intervals(ninterval) logical, optional, intent(in) :: do_nearest - + if (ninterval > NMaxAlbedoIntervals) then write(nulerr,'(a,i0,a,i0)') '*** Error: ', ninterval, & & ' albedo intervals exceeds maximum of ', NMaxAlbedoIntervals @@ -1872,7 +1800,7 @@ subroutine define_lw_emiss_intervals(this, ninterval, wavelength_bound, & ! The emissivity indices corresponding to each interval integer, intent(in) :: i_intervals(ninterval) logical, optional, intent(in) :: do_nearest - + if (ninterval > NMaxAlbedoIntervals) then write(nulerr,'(a,i0,a,i0)') '*** Error: ', ninterval, & & ' emissivity intervals exceeds maximum of ', NMaxAlbedoIntervals @@ -1905,7 +1833,7 @@ end subroutine define_lw_emiss_intervals subroutine set_aerosol_wavelength_mono(this, wavelength_mono) use radiation_io, only : nulerr, radiation_abort - + class(config_type), intent(inout) :: this real(jprb), intent(in) :: wavelength_mono(:) @@ -1913,7 +1841,7 @@ subroutine set_aerosol_wavelength_mono(this, wavelength_mono) write(nulerr,'(a)') '*** Errror: set_aerosol_wavelength_mono must be called before setup_radiation' call radiation_abort('Radiation configuration error') end if - + if (allocated(this%aerosol_optics%wavelength_mono)) then deallocate(this%aerosol_optics%wavelength_mono) end if @@ -1953,17 +1881,17 @@ subroutine consolidate_sw_albedo_intervals(this) this%i_sw_albedo_index(2:) = 0 if (this%use_canopy_full_spectrum_sw) then this%n_canopy_bands_sw = this%n_g_sw - else + else this%n_canopy_bands_sw = 1 end if else if (this%use_canopy_full_spectrum_sw) then this%n_canopy_bands_sw = this%n_g_sw - else + else this%n_canopy_bands_sw = maxval(this%i_sw_albedo_index(1:ninterval)) end if end if - + if (this%do_weighted_surface_mapping) then call this%gas_optics_sw%spectral_def%calc_mapping_from_bands( & & this%sw_albedo_wavelength_bound(1:ninterval-1), this%i_sw_albedo_index(1:ninterval), & @@ -1997,7 +1925,7 @@ subroutine consolidate_sw_albedo_intervals(this) write(nulout, '()') end if end if - + end subroutine consolidate_sw_albedo_intervals @@ -2031,13 +1959,13 @@ subroutine consolidate_lw_emiss_intervals(this) this%i_lw_emiss_index(2:) = 0 if (this%use_canopy_full_spectrum_sw) then this%n_canopy_bands_lw = this%n_g_lw - else + else this%n_canopy_bands_lw = 1 end if else if (this%use_canopy_full_spectrum_lw) then this%n_canopy_bands_lw = this%n_g_lw - else + else this%n_canopy_bands_lw = maxval(this%i_lw_emiss_index(1:ninterval)) end if end if @@ -2155,6 +2083,7 @@ end subroutine print_integer !--------------------------------------------------------------------- ! Print one line of information: real subroutine print_real(message_str, name, val) + use parkind1, only : jprb use radiation_io, only : nulout character(len=*), intent(in) :: message_str character(len=*), intent(in) :: name diff --git a/radiation/radiation_ecckd.F90 b/radiation/radiation_ecckd.F90 index 2089b8de..8c6dbd2f 100644 --- a/radiation/radiation_ecckd.F90 +++ b/radiation/radiation_ecckd.F90 @@ -14,8 +14,6 @@ ! License: see the COPYING file for details ! -#include "ecrad_config.h" - module radiation_ecckd use parkind1, only : jprb @@ -104,13 +102,7 @@ module radiation_ecckd procedure :: read => read_ckd_model procedure :: read_spectral_solar_cycle -! Vectorized version of the optical depth look-up performs better on -! NEC, but slower on x86 -#ifdef DWD_VECTOR_OPTIMIZATIONS - procedure :: calc_optical_depth => calc_optical_depth_ckd_model_vec -#else procedure :: calc_optical_depth => calc_optical_depth_ckd_model -#endif procedure :: print => print_ckd_model procedure :: calc_planck_function procedure :: calc_incoming_sw @@ -126,13 +118,9 @@ module radiation_ecckd ! "filename" subroutine read_ckd_model(this, filename, iverbose) -#ifdef EASY_NETCDF_READ_MPI - use easy_netcdf_read_mpi, only : netcdf_file -#else - use easy_netcdf, only : netcdf_file -#endif + use easy_netcdf_read_mpi, only : netcdf_file !use radiation_io, only : nulerr, radiation_abort - use yomhook, only : lhook, dr_hook, jphook + use yomhook, only : lhook, dr_hook, jphook class(ckd_model_type), intent(inout) :: this character(len=*), intent(in) :: filename @@ -294,13 +282,9 @@ end subroutine print_ckd_model ! solar cycle and map to g-points subroutine read_spectral_solar_cycle(this, filename, iverbose, use_updated_solar_spectrum) -#ifdef EASY_NETCDF_READ_MPI use easy_netcdf_read_mpi, only : netcdf_file -#else - use easy_netcdf, only : netcdf_file -#endif - use radiation_io, only : nulout, nulerr, radiation_abort - use yomhook, only : lhook, dr_hook, jphook + use radiation_io, only : nulout, nulerr, radiation_abort + use yomhook, only : lhook, dr_hook, jphook ! Reference total solar irradiance (W m-2) real(jprb), parameter :: ReferenceTSI = 1361.0_jprb @@ -456,7 +440,7 @@ end subroutine read_spectral_solar_cycle ! at nlev layers subroutine calc_optical_depth_ckd_model(this, ncol, nlev, istartcol, iendcol, nmaxgas, & & pressure_hl, temperature_fl, mole_fraction_fl, & - & optical_depth_fl, rayleigh_od_fl, concentration_scaling) + & optical_depth_fl, rayleigh_od_fl) use yomhook, only : lhook, dr_hook, jphook use radiation_constants, only : AccelDueToGravity @@ -472,8 +456,6 @@ subroutine calc_optical_depth_ckd_model(this, ncol, nlev, istartcol, iendcol, nm real(jprb), intent(in) :: temperature_fl(istartcol:iendcol,nlev) ! Gas mole fractions at full levels (mol mol-1), dimensioned (ncol,nlev,nmaxgas) real(jprb), intent(in) :: mole_fraction_fl(ncol,nlev,nmaxgas) - ! Optional concentration scaling of each gas - real(jprb), optional, intent(in) :: concentration_scaling(nmaxgas) ! Output variables @@ -494,7 +476,6 @@ subroutine calc_optical_depth_ckd_model(this, ncol, nlev, istartcol, iendcol, nm !real(jprb) :: od_single_gas(this%ng) real(jprb) :: multiplier(nlev), simple_multiplier(nlev), global_multiplier, temperature1 - real(jprb) :: scaling ! Indices and weights in temperature, pressure and concentration interpolation real(jprb) :: pindex1, tindex1, cindex1 @@ -556,10 +537,6 @@ subroutine calc_optical_depth_ckd_model(this, ncol, nlev, istartcol, iendcol, nm molar_abs => this%single_gas(jgas)%molar_abs multiplier = simple_multiplier * mole_fraction_fl(jcol,:,igascode) - if (present(concentration_scaling)) then - multiplier = multiplier * concentration_scaling(igascode) - end if - do jlev = 1,nlev optical_depth_fl(:,jlev,jcol) = optical_depth_fl(:,jlev,jcol) & & + (multiplier(jlev)*tw1(jlev)) * (pw1(jlev) * molar_abs(:,ip1(jlev),it1(jlev)) & @@ -570,16 +547,8 @@ subroutine calc_optical_depth_ckd_model(this, ncol, nlev, istartcol, iendcol, nm case (IConcDependenceRelativeLinear) molar_abs => this%single_gas(jgas)%molar_abs - - if (present(concentration_scaling)) then - multiplier = simple_multiplier & - & * (mole_fraction_fl(jcol,:,igascode)*concentration_scaling(igascode) & - & - single_gas%reference_mole_frac) - else - multiplier = simple_multiplier * (mole_fraction_fl(jcol,:,igascode) & - & - single_gas%reference_mole_frac) - end if - + multiplier = simple_multiplier * (mole_fraction_fl(jcol,:,igascode) & + & - single_gas%reference_mole_frac) do jlev = 1,nlev optical_depth_fl(:,jlev,jcol) = optical_depth_fl(:,jlev,jcol) & & + (multiplier(jlev)*tw1(jlev)) * (pw1(jlev) * molar_abs(:,ip1(jlev),it1(jlev)) & @@ -600,19 +569,12 @@ subroutine calc_optical_depth_ckd_model(this, ncol, nlev, istartcol, iendcol, nm end do case (IConcDependenceLUT) - - if (present(concentration_scaling)) then - scaling = concentration_scaling(igascode) - else - scaling = 1.0_jprb - end if - ! Logarithmic interpolation in concentration space molar_abs_conc => this%single_gas(jgas)%molar_abs_conc mole_frac1 = exp(single_gas%log_mole_frac1) do jlev = 1,nlev ! Take care of mole_fraction == 0 - log_conc = log(max(mole_fraction_fl(jcol,jlev,igascode)*scaling, mole_frac1)) + log_conc = log(max(mole_fraction_fl(jcol,jlev,igascode), mole_frac1)) cindex1 = (log_conc - single_gas%log_mole_frac1) / single_gas%d_log_mole_frac cindex1 = 1.0_jprb + max(0.0_jprb, min(cindex1, single_gas%n_mole_frac-1.0001_jprb)) ic1(jlev) = int(cindex1) @@ -629,7 +591,7 @@ subroutine calc_optical_depth_ckd_model(this, ncol, nlev, istartcol, iendcol, nm ! & +pw2 * molar_abs_conc(:,ip1+1,it1+1,ic1+1))) do jlev = 1,nlev optical_depth_fl(:,jlev,jcol) = optical_depth_fl(:,jlev,jcol) & - & + (simple_multiplier(jlev) * mole_fraction_fl(jcol,jlev,igascode) * scaling) * ( & + & + (simple_multiplier(jlev) * mole_fraction_fl(jcol,jlev,igascode)) * ( & & (cw1(jlev) * tw1(jlev) * pw1(jlev)) * molar_abs_conc(:,ip1(jlev),it1(jlev),ic1(jlev)) & & +(cw1(jlev) * tw1(jlev) * pw2(jlev)) * molar_abs_conc(:,ip1(jlev)+1,it1(jlev),ic1(jlev)) & & +(cw1(jlev) * tw2(jlev) * pw1(jlev)) * molar_abs_conc(:,ip1(jlev),it1(jlev)+1,ic1(jlev)) & @@ -662,236 +624,6 @@ subroutine calc_optical_depth_ckd_model(this, ncol, nlev, istartcol, iendcol, nm end subroutine calc_optical_depth_ckd_model - - !--------------------------------------------------------------------- - ! Vectorized variant of above routine - subroutine calc_optical_depth_ckd_model_vec(this, ncol, nlev, istartcol, iendcol, nmaxgas, & - & pressure_hl, temperature_fl, mole_fraction_fl, & - & optical_depth_fl, rayleigh_od_fl) - - use yomhook, only : lhook, dr_hook, jphook - use radiation_constants, only : AccelDueToGravity - - ! Input variables - - class(ckd_model_type), intent(in), target :: this - ! Number of columns, levels and input gases - integer, intent(in) :: ncol, nlev, nmaxgas, istartcol, iendcol - ! Pressure at half levels (Pa), dimensioned (ncol,nlev+1) - real(jprb), intent(in) :: pressure_hl(ncol,nlev+1) - ! Temperature at full levels (K), dimensioned (ncol,nlev) - real(jprb), intent(in) :: temperature_fl(istartcol:iendcol,nlev) - ! Gas mole fractions at full levels (mol mol-1), dimensioned (ncol,nlev,nmaxgas) - real(jprb), intent(in) :: mole_fraction_fl(ncol,nlev,nmaxgas) - - ! Output variables - - ! Layer absorption optical depth for each g point - real(jprb), intent(out) :: optical_depth_fl(this%ng,nlev,istartcol:iendcol) - ! In the shortwave only, the Rayleigh scattering optical depth - real(jprb), optional, intent(out) :: rayleigh_od_fl(this%ng,nlev,istartcol:iendcol) - - ! Local variables - - real(jprb), pointer :: molar_abs(:,:,:), molar_abs_conc(:,:,:,:) - - ! Natural logarithm of pressure at full levels - real(jprb) :: log_pressure_fl - - ! Optical depth of single gas at one point in space versus - ! spectral interval - !real(jprb) :: od_single_gas(this%ng) - - real(jprb) :: multiplier, simple_multiplier(ncol,nlev), global_multiplier, temperature1 - - ! Indices and weights in temperature, pressure and concentration interpolation - real(jprb) :: pindex1, tindex1, cindex1 - real(jprb) :: pw1(ncol,nlev), pw2(ncol,nlev), tw1(ncol,nlev), tw2(ncol,nlev), cw1(ncol,nlev), cw2(ncol,nlev) - integer :: ip1(ncol,nlev), it1(ncol,nlev), ic1(ncol,nlev) - - ! Natural logarithm of mole fraction at one point - real(jprb) :: log_conc - - ! Minimum mole fraction in look-up-table - real(jprb) :: mole_frac1 - - ! Layer absorption optical depth for each g point (memory layout adjusted to vectorization) - real(jprb) :: od_fl(ncol,this%ng,nlev) - - integer :: jcol, jlev, jgas, igascode, jg - - real(jphook) :: hook_handle - - if (lhook) call dr_hook('radiation_ecckd:calc_optical_depth_vec',0,hook_handle) - - global_multiplier = 1.0_jprb / (AccelDueToGravity * 0.001_jprb * AirMolarMass) - - od_fl(:,:,:) = 0.0_jprb - - do jlev = 1,nlev - do jcol = istartcol,iendcol - - log_pressure_fl = log(0.5_jprb * (pressure_hl(jcol,jlev)+pressure_hl(jcol,jlev+1))) - - ! Find interpolation points in pressure - pindex1 = (log_pressure_fl-this%log_pressure1) & - & / this%d_log_pressure - pindex1 = 1.0_jprb + max(0.0_jprb, min(pindex1, this%npress-1.0001_jprb)) - ip1(jcol,jlev) = int(pindex1) - pw2(jcol,jlev) = pindex1 - ip1(jcol,jlev) - pw1(jcol,jlev) = 1.0_jprb - pw2(jcol,jlev) - - ! Find interpolation points in temperature - temperature1 = pw1(jcol,jlev)*this%temperature1(ip1(jcol,jlev)) & - & + pw2(jcol,jlev)*this%temperature1(ip1(jcol,jlev)+1) - tindex1 = (temperature_fl(jcol,jlev) - temperature1) & - & / this%d_temperature - tindex1 = 1.0_jprb + max(0.0_jprb, min(tindex1, this%ntemp-1.0001_jprb)) - it1(jcol,jlev) = int(tindex1) - tw2(jcol,jlev) = tindex1 - it1(jcol,jlev) - tw1(jcol,jlev) = 1.0_jprb - tw2(jcol,jlev) - - ! Concentration multiplier - simple_multiplier(jcol,jlev) = global_multiplier & - & * (pressure_hl(jcol,jlev+1) - pressure_hl(jcol,jlev)) - end do - end do - - do jgas = 1,this%ngas - - associate (single_gas => this%single_gas(jgas)) - igascode = this%single_gas(jgas)%i_gas_code - - select case (single_gas%i_conc_dependence) - - case (IConcDependenceLinear) - molar_abs => this%single_gas(jgas)%molar_abs - - do jlev = 1,nlev - do jg = 1, this%ng - do jcol = istartcol,iendcol - multiplier = simple_multiplier(jcol,jlev) * mole_fraction_fl(jcol,jlev,igascode) - - od_fl(jcol,jg,jlev) = od_fl(jcol,jg,jlev) & - & + (multiplier*tw1(jcol,jlev)) * (pw1(jcol,jlev) * molar_abs(jg,ip1(jcol,jlev),it1(jcol,jlev)) & - & +pw2(jcol,jlev) * molar_abs(jg,ip1(jcol,jlev)+1,it1(jcol,jlev))) & - & + (multiplier*tw2(jcol,jlev)) * (pw1(jcol,jlev) * molar_abs(jg,ip1(jcol,jlev),it1(jcol,jlev)+1) & - & +pw2(jcol,jlev) * molar_abs(jg,ip1(jcol,jlev)+1,it1(jcol,jlev)+1)) - end do - end do - end do - - case (IConcDependenceRelativeLinear) - molar_abs => this%single_gas(jgas)%molar_abs - - do jlev = 1,nlev - do jg = 1, this%ng - do jcol = istartcol,iendcol - multiplier = simple_multiplier(jcol,jlev) * (mole_fraction_fl(jcol,jlev,igascode) & - & - single_gas%reference_mole_frac) - - od_fl(jcol,jg,jlev) = od_fl(jcol,jg,jlev) & - & + (multiplier*tw1(jcol,jlev)) * (pw1(jcol,jlev) * molar_abs(jg,ip1(jcol,jlev),it1(jcol,jlev)) & - & +pw2(jcol,jlev) * molar_abs(jg,ip1(jcol,jlev)+1,it1(jcol,jlev))) & - & + (multiplier*tw2(jcol,jlev)) * (pw1(jcol,jlev) * molar_abs(jg,ip1(jcol,jlev),it1(jcol,jlev)+1) & - & +pw2(jcol,jlev) * molar_abs(jg,ip1(jcol,jlev)+1,it1(jcol,jlev)+1)) - end do - end do - end do - - case (IConcDependenceNone) - ! Composite gases - molar_abs => this%single_gas(jgas)%molar_abs - - do jlev = 1,nlev - do jg = 1, this%ng - do jcol = istartcol,iendcol - od_fl(jcol,jg,jlev) = od_fl(jcol,jg,jlev) & - & + (simple_multiplier(jcol,jlev)*tw1(jcol,jlev)) * & - & (pw1(jcol,jlev) * molar_abs(jg,ip1(jcol,jlev),it1(jcol,jlev)) & - & +pw2(jcol,jlev) * molar_abs(jg,ip1(jcol,jlev)+1,it1(jcol,jlev))) & - & + (simple_multiplier(jcol,jlev)*tw2(jcol,jlev)) * & - & (pw1(jcol,jlev) * molar_abs(jg,ip1(jcol,jlev),it1(jcol,jlev)+1) & - & +pw2(jcol,jlev) * molar_abs(jg,ip1(jcol,jlev)+1,it1(jcol,jlev)+1)) - end do - end do - end do - - case (IConcDependenceLUT) - ! Logarithmic interpolation in concentration space - molar_abs_conc => this%single_gas(jgas)%molar_abs_conc - mole_frac1 = exp(single_gas%log_mole_frac1) - - do jlev = 1,nlev - do jcol = istartcol,iendcol - ! Take care of mole_fraction == 0 - log_conc = log(max(mole_fraction_fl(jcol,jlev,igascode), mole_frac1)) - cindex1 = (log_conc - single_gas%log_mole_frac1) / single_gas%d_log_mole_frac - cindex1 = 1.0_jprb + max(0.0_jprb, min(cindex1, single_gas%n_mole_frac-1.0001_jprb)) - ic1(jcol,jlev) = int(cindex1) - cw2(jcol,jlev) = cindex1 - ic1(jcol,jlev) - cw1(jcol,jlev) = 1.0_jprb - cw2(jcol,jlev) - end do - end do - - do jlev = 1,nlev - do jg = 1, this%ng -!NEC$ select_vector - do jcol = istartcol,iendcol - - od_fl(jcol,jg,jlev) = od_fl(jcol,jg,jlev) & - & + (simple_multiplier(jcol,jlev) * mole_fraction_fl(jcol,jlev,igascode)) * ( & - & (cw1(jcol,jlev) * tw1(jcol,jlev) * pw1(jcol,jlev)) * & - & molar_abs_conc(jg,ip1(jcol,jlev),it1(jcol,jlev),ic1(jcol,jlev)) & - & +(cw1(jcol,jlev) * tw1(jcol,jlev) * pw2(jcol,jlev)) * & - & molar_abs_conc(jg,ip1(jcol,jlev)+1,it1(jcol,jlev),ic1(jcol,jlev)) & - & +(cw1(jcol,jlev) * tw2(jcol,jlev) * pw1(jcol,jlev)) * & - & molar_abs_conc(jg,ip1(jcol,jlev),it1(jcol,jlev)+1,ic1(jcol,jlev)) & - & +(cw1(jcol,jlev) * tw2(jcol,jlev) * pw2(jcol,jlev)) * & - & molar_abs_conc(jg,ip1(jcol,jlev)+1,it1(jcol,jlev)+1,ic1(jcol,jlev)) & - & +(cw2(jcol,jlev) * tw1(jcol,jlev) * pw1(jcol,jlev)) * & - & molar_abs_conc(jg,ip1(jcol,jlev),it1(jcol,jlev),ic1(jcol,jlev)+1) & - & +(cw2(jcol,jlev) * tw1(jcol,jlev) * pw2(jcol,jlev)) * & - & molar_abs_conc(jg,ip1(jcol,jlev)+1,it1(jcol,jlev),ic1(jcol,jlev)+1) & - & +(cw2(jcol,jlev) * tw2(jcol,jlev) * pw1(jcol,jlev)) * & - & molar_abs_conc(jg,ip1(jcol,jlev),it1(jcol,jlev)+1,ic1(jcol,jlev)+1) & - & +(cw2(jcol,jlev) * tw2(jcol,jlev) * pw2(jcol,jlev)) * & - & molar_abs_conc(jg,ip1(jcol,jlev)+1,it1(jcol,jlev)+1,ic1(jcol,jlev)+1)) - end do - end do - end do - end select - - end associate - - ! Ensure the optical depth is not negative - do jcol = istartcol,iendcol - do jlev = 1,nlev - do jg = 1, this%ng - optical_depth_fl(jg,jlev,jcol) = max(0.0_jprb, od_fl(jcol,jg,jlev)) - end do - end do - end do - - ! Rayleigh scattering - if (this%is_sw .and. present(rayleigh_od_fl)) then - do jcol = istartcol,iendcol - do jlev = 1,nlev - do jg = 1, this%ng - rayleigh_od_fl(jg,jlev,jcol) = global_multiplier & - & * (pressure_hl(jcol,jlev+1) - pressure_hl(jcol,jlev)) * this%rayleigh_molar_scat(jg) - end do - end do - end do - end if - - end do - - if (lhook) call dr_hook('radiation_ecckd:calc_optical_depth_vec',1,hook_handle) - - end subroutine calc_optical_depth_ckd_model_vec - - !--------------------------------------------------------------------- ! Calculate the Planck function integrated across each of the g ! points of this correlated k-distribution model, for a given diff --git a/radiation/radiation_ecckd_gas.F90 b/radiation/radiation_ecckd_gas.F90 index a1a67053..503c7a8f 100644 --- a/radiation/radiation_ecckd_gas.F90 +++ b/radiation/radiation_ecckd_gas.F90 @@ -14,8 +14,6 @@ ! License: see the COPYING file for details ! -#include "ecrad_config.h" - module radiation_ecckd_gas use parkind1, only : jprb @@ -83,11 +81,7 @@ module radiation_ecckd_gas ! NetCDF file, identifying it with code i_gas_code subroutine read_ckd_gas(this, file, gas_name, i_gas_code) -#ifdef EASY_NETCDF_READ_MPI use easy_netcdf_read_mpi, only : netcdf_file -#else - use easy_netcdf, only : netcdf_file -#endif class(ckd_gas_type), intent(inout) :: this type(netcdf_file), intent(inout) :: file diff --git a/radiation/radiation_ecckd_interface.F90 b/radiation/radiation_ecckd_interface.F90 index 2e014e34..9782b084 100644 --- a/radiation/radiation_ecckd_interface.F90 +++ b/radiation/radiation_ecckd_interface.F90 @@ -38,7 +38,7 @@ subroutine setup_gas_optics(config) if (lhook) call dr_hook('radiation_ecckd_interface:setup_gas_optics',0,hook_handle) - if (config%do_sw .and. config%i_gas_model_sw == IGasModelECCKD) then + if (config%do_sw) then ! Read shortwave ecCKD gas optics NetCDF file call config%gas_optics_sw%read(trim(config%gas_optics_sw_file_name), & @@ -83,7 +83,7 @@ subroutine setup_gas_optics(config) end if - if (config%do_lw .and. config%i_gas_model_lw == IGasModelECCKD) then + if (config%do_lw) then ! Read longwave ecCKD gas optics NetCDF file call config%gas_optics_lw%read(trim(config%gas_optics_lw_file_name), & @@ -179,7 +179,7 @@ subroutine gas_optics(ncol,nlev,istartcol,iendcol, & use parkind1, only : jprb use yomhook, only : lhook, dr_hook, jphook - use radiation_config, only : config_type, IGasModelECCKD + use radiation_config, only : config_type use radiation_thermodynamics, only : thermodynamics_type use radiation_single_level, only : single_level_type use radiation_gas_constants, only : NMaxGases @@ -222,11 +222,7 @@ subroutine gas_optics(ncol,nlev,istartcol,iendcol, & ! Temperature at full levels (K) real(jprb) :: temperature_fl(istartcol:iendcol,nlev) - real(jprb) :: concentration_scaling(NMaxGases) - - logical :: is_volume_mixing_ratio - - integer :: jcol, jlev, jg + integer :: jcol real(jphook) :: hook_handle @@ -243,42 +239,21 @@ subroutine gas_optics(ncol,nlev,istartcol,iendcol, & & *thermodynamics%pressure_hl(istartcol:iendcol,2:nlev+1)) & & / (thermodynamics%pressure_hl(istartcol:iendcol,1:nlev) & & +thermodynamics%pressure_hl(istartcol:iendcol,2:nlev+1)) - - ! Check that the gas concentrations are stored in volume mixing - ! ratio with no scaling; if not, return a vector of scalings - call gas%assert_units(IVolumeMixingRatio, scale_factor=1.0_jprb, & - & istatus=is_volume_mixing_ratio) - if (.not. is_volume_mixing_ratio) then - call gas%get_scaling(IVolumeMixingRatio, concentration_scaling) - else - concentration_scaling = 1.0_jprb - end if - - if (config%do_sw .and. config%i_gas_model_sw == IGasModelECCKD) then - - if (is_volume_mixing_ratio) then - call config%gas_optics_sw%calc_optical_depth(ncol,nlev,istartcol,iendcol, & - & NMaxGases, thermodynamics%pressure_hl, & - & temperature_fl, gas%mixing_ratio, & - & od_sw, rayleigh_od_fl=ssa_sw) - else - call config%gas_optics_sw%calc_optical_depth(ncol,nlev,istartcol,iendcol, & - & NMaxGases, thermodynamics%pressure_hl, & - & temperature_fl, gas%mixing_ratio, & - & od_sw, rayleigh_od_fl=ssa_sw, concentration_scaling=concentration_scaling) - end if - + + if (config%do_sw) then + + call config%gas_optics_sw%calc_optical_depth(ncol,nlev,istartcol,iendcol, & + & NMaxGases, thermodynamics%pressure_hl, & + & temperature_fl, & + & gas%mixing_ratio, & +! & reshape(gas%mixing_ratio(istartcol:iendcol,:,:), & +! & [nlev,iendcol-istartcol+1,NMaxGases],order=[2,1,3]), & + & od_sw, rayleigh_od_fl=ssa_sw) ! At this point od_sw = absorption optical depth and ssa_sw = ! rayleigh optical depth: convert to total optical depth and ! single-scattering albedo - do jcol = istartcol,iendcol - do jlev = 1, nlev - do jg = 1, config%n_g_sw - od_sw(jg,jlev,jcol) = od_sw(jg,jlev,jcol) + ssa_sw(jg,jlev,jcol) - ssa_sw(jg,jlev,jcol) = ssa_sw(jg,jlev,jcol) / od_sw(jg,jlev,jcol) - end do - end do - end do + od_sw = od_sw + ssa_sw + ssa_sw = ssa_sw / od_sw if (present(incoming_sw)) then if (single_level%spectral_solar_cycle_multiplier == 0.0_jprb) then @@ -292,19 +267,15 @@ subroutine gas_optics(ncol,nlev,istartcol,iendcol, & end if - if (config%do_lw .and. config%i_gas_model_lw == IGasModelECCKD) then + if (config%do_lw) then - if (is_volume_mixing_ratio) then - call config%gas_optics_lw%calc_optical_depth(ncol,nlev,istartcol,iendcol, & - & NMaxGases, thermodynamics%pressure_hl, & - & temperature_fl, gas%mixing_ratio, & - & od_lw) - else - call config%gas_optics_lw%calc_optical_depth(ncol,nlev,istartcol,iendcol, & - & NMaxGases, thermodynamics%pressure_hl, & - & temperature_fl, gas%mixing_ratio, & - & od_lw, concentration_scaling=concentration_scaling) - end if + call config%gas_optics_lw%calc_optical_depth(ncol,nlev,istartcol,iendcol, & + & NMaxGases, thermodynamics%pressure_hl, & + & temperature_fl, & + & gas%mixing_ratio, & +! & reshape(gas%mixing_ratio(istartcol:iendcol,:,:), & +! & [nlev,iendcol-istartcol+1,NMaxGases],order=[2,1,3]), & + & od_lw) ! Calculate the Planck function for each g point do jcol = istartcol,iendcol @@ -314,7 +285,6 @@ subroutine gas_optics(ncol,nlev,istartcol,iendcol, & call config%gas_optics_lw%calc_planck_function(iendcol+1-istartcol, & & single_level%skin_temperature(istartcol:iendcol), & & lw_emission(:,:)) -!NEC$ forced_collapse lw_emission = lw_emission * (1.0_jprb - lw_albedo) end if diff --git a/radiation/radiation_flux.F90 b/radiation/radiation_flux.F90 index 8f9c92bf..232ce525 100644 --- a/radiation/radiation_flux.F90 +++ b/radiation/radiation_flux.F90 @@ -20,8 +20,6 @@ ! 2021-01-20 R. Hogan Added heating_rate_out_of_physical_bounds function ! 2022-12-07 R. Hogan Added top-of-atmosphere spectral output -#include "ecrad_config.h" - module radiation_flux use parkind1, only : jprb @@ -118,7 +116,7 @@ module radiation_flux end type flux_type ! Added for DWD (2020) -#ifdef DWD_VECTOR_OPTIMIZATIONS +#ifdef __SX__ logical, parameter :: use_indexed_sum_vec = .true. #else logical, parameter :: use_indexed_sum_vec = .false. diff --git a/radiation/radiation_gas.F90 b/radiation/radiation_gas.F90 index 6516fc08..8f2b6423 100644 --- a/radiation/radiation_gas.F90 +++ b/radiation/radiation_gas.F90 @@ -42,7 +42,7 @@ module radiation_gas ! 1.0e-6 is used to indicate the units are actually PPMV: need to ! multiply by 1e-6 to get mol/mol. real(jprb) :: scale_factor(NMaxGases) = 1.0_jprb - + ! Mixing ratios of variable gases, dimensioned (ncol, nlev, ! NMaxGases) real(jprb), allocatable, dimension(:,:,:) :: mixing_ratio @@ -61,7 +61,7 @@ module radiation_gas ! A list of length ntype of gases whose volume mixing ratios have ! been provided integer :: icode(NMaxGases) = 0 - + contains procedure :: allocate => allocate_gas procedure :: deallocate => deallocate_gas @@ -71,7 +71,6 @@ module radiation_gas procedure :: set_units => set_units_gas procedure :: assert_units => assert_units_gas procedure :: get => get_gas - procedure :: get_scaling procedure :: reverse => reverse_gas procedure :: out_of_physical_bounds end type gas_type @@ -121,7 +120,7 @@ subroutine deallocate_gas(this) if (allocated(this%mixing_ratio)) then deallocate(this%mixing_ratio) end if - + this%iunits = 0 this%scale_factor = 0.0_jprb this%is_present = .false. @@ -353,9 +352,9 @@ recursive subroutine set_units_gas(this, iunits, igas, scale_factor) class(gas_type), intent(inout) :: this integer, intent(in) :: iunits integer, optional, intent(in) :: igas - real(jprb), optional, intent(in) :: scale_factor + real(jprb), optional, intent(in) :: scale_factor - integer :: jg + integer :: ig ! Scaling factor to convert from old to new real(jprb) :: sf @@ -386,7 +385,7 @@ recursive subroutine set_units_gas(this, iunits, igas, scale_factor) sf = sf * AirMolarMass / GasMolarMass(igas) end if sf = sf * this%scale_factor(igas) - + if (sf /= 1.0_jprb) then this%mixing_ratio(:,:,igas) = this%mixing_ratio(:,:,igas) * sf end if @@ -396,55 +395,30 @@ recursive subroutine set_units_gas(this, iunits, igas, scale_factor) this%scale_factor(igas) = new_sf end if else - do jg = 1,this%ntype - call this%set_units(iunits, igas=this%icode(jg), scale_factor=new_sf) + do ig = 1,this%ntype + call this%set_units(iunits, igas=this%icode(ig), scale_factor=new_sf) end do end if end subroutine set_units_gas - - !--------------------------------------------------------------------- - ! Return a vector indicating the scaling that one would need to - ! apply to each gas in order to obtain the dimension units in - ! "iunits" (which can be IVolumeMixingRatio or IMassMixingRatio) - subroutine get_scaling(this, iunits, scaling) - class(gas_type), intent(in) :: this - integer, intent(in) :: iunits - real(jprb), intent(out) :: scaling(NMaxGases) - integer :: jg - - scaling = this%scale_factor - do jg = 1,NMaxGases - if (iunits == IMassMixingRatio .and. this%iunits(jg) == IVolumeMixingRatio) then - scaling(jg) = scaling(jg) * GasMolarMass(jg) / AirMolarMass - else if (iunits == IVolumeMixingRatio .and. this%iunits(jg) == IMassMixingRatio) then - scaling(jg) = scaling(jg) * AirMolarMass / GasMolarMass(jg) - end if - end do - - end subroutine get_scaling - !--------------------------------------------------------------------- ! Assert that gas mixing ratio units are "iunits", applying to gas ! with ID "igas" if present, otherwise to all gases. Otherwise the - ! program will exit, except if the optional argument "istatus" is - ! provided in which case it will return true if the units are - ! correct and false if they are not. Optional argument scale factor - ! specifies any subsequent multiplication to apply; for PPMV one - ! would use iunits=IVolumeMixingRatio and scale_factor=1.0e6. - recursive subroutine assert_units_gas(this, iunits, igas, scale_factor, istatus) - - use radiation_io, only : nulerr, radiation_abort + ! program will exit. Otional argument scale factor specifies any + ! subsequent multiplication to apply; for PPMV one would use + ! iunits=IVolumeMixingRatio and scale_factor=1.0e6. + recursive subroutine assert_units_gas(this, iunits, igas, scale_factor) + + use radiation_io, only : nulerr, radiation_abort - class(gas_type), intent(in) :: this - integer, intent(in) :: iunits - integer, optional, intent(in) :: igas - real(jprb), optional, intent(in) :: scale_factor - logical, optional, intent(out) :: istatus + class(gas_type), intent(in) :: this + integer, intent(in) :: iunits + integer, optional, intent(in) :: igas + real(jprb), optional, intent(in) :: scale_factor - integer :: jg + integer :: ig real(jprb) :: sf @@ -454,34 +428,22 @@ recursive subroutine assert_units_gas(this, iunits, igas, scale_factor, istatus) sf = 1.0_jprb end if - if (present(istatus)) then - istatus = .true. - end if - if (present(igas)) then if (this%is_present(igas)) then if (iunits /= this%iunits(igas)) then - if (present(istatus)) then - istatus = .false. - else - write(nulerr,'(a,a,a)') '*** Error: ', trim(GasName(igas)), & - & ' is not in the required units' - call radiation_abort() - end if + write(nulerr,'(a,a,a)') '*** Error: ', trim(GasName(igas)), & + & ' is not in the required units' + call radiation_abort() else if (sf /= this%scale_factor(igas)) then - if (present(istatus)) then - istatus = .false. - else - write(nulerr,'(a,a,a,e12.4,a,e12.4)') '*** Error: ', GasName(igas), & - & ' scaling of ', this%scale_factor(igas), & - & ' does not match required ', sf - call radiation_abort() - end if + write(nulerr,'(a,a,a,e12.4,a,e12.4)') '*** Error: ', GasName(igas), & + & ' scaling of ', this%scale_factor(igas), & + & ' does not match required ', sf + call radiation_abort() end if end if else - do jg = 1,this%ntype - call this%assert_units(iunits, igas=this%icode(jg), scale_factor=sf, istatus=istatus) + do ig = 1,this%ntype + call this%assert_units(iunits, igas=this%icode(ig), scale_factor=sf) end do end if @@ -541,7 +503,7 @@ subroutine get_gas(this, igas, iunits, mixing_ratio, scale_factor, & if (.not. this%is_present(igas)) then mixing_ratio = 0.0_jprb - else + else if (iunits == IMassMixingRatio & & .and. this%iunits(igas) == IVolumeMixingRatio) then sf = sf * GasMolarMass(igas) / AirMolarMass @@ -550,7 +512,7 @@ subroutine get_gas(this, igas, iunits, mixing_ratio, scale_factor, & sf = sf * AirMolarMass / GasMolarMass(igas) end if sf = sf * this%scale_factor(igas) - + if (sf /= 1.0_jprb) then mixing_ratio = this%mixing_ratio(i1:i2,:,igas) * sf else @@ -568,7 +530,7 @@ end subroutine get_gas ! data subroutine reverse_gas(this, istartcol, iendcol, gas_rev) - class(gas_type), intent(in) :: this + class(gas_type) :: this integer, intent(in) :: istartcol, iendcol type(gas_type), intent(out) :: gas_rev @@ -622,5 +584,5 @@ function out_of_physical_bounds(this, istartcol, iendcol, do_fix) result(is_bad) if (lhook) call dr_hook('radiation_gas:out_of_physical_bounds',1,hook_handle) end function out_of_physical_bounds - + end module radiation_gas diff --git a/radiation/radiation_general_cloud_optics.F90 b/radiation/radiation_general_cloud_optics.F90 index dcef224b..ddca8de2 100644 --- a/radiation/radiation_general_cloud_optics.F90 +++ b/radiation/radiation_general_cloud_optics.F90 @@ -107,7 +107,6 @@ subroutine setup_general_cloud_optics(config) & use_thick_averaging=config%use_thick_cloud_spectral_averaging(jtype), & & weighting_temperature=SolarReferenceTemperature, & & iverbose=config%iverbosesetup) - config%cloud_optics_sw(jtype)%type_name = trim(config%cloud_type_name(jtype)) end if if (config%do_lw) then @@ -120,7 +119,6 @@ subroutine setup_general_cloud_optics(config) & use_thick_averaging=config%use_thick_cloud_spectral_averaging(jtype), & & weighting_temperature=TerrestrialReferenceTemperature, & & iverbose=config%iverbosesetup) - config%cloud_optics_lw(jtype)%type_name = trim(config%cloud_type_name(jtype)) end if end do @@ -169,7 +167,7 @@ subroutine general_cloud_optics(nlev,istartcol,iendcol, & ! In-cloud water path of one cloud type (kg m-2) real(jprb), dimension(istartcol:iendcol,nlev) :: water_path - integer :: jtype, jcol, jlev, jg + integer :: jtype, jcol, jlev real(jphook) :: hook_handle @@ -272,12 +270,10 @@ subroutine general_cloud_optics(nlev,istartcol,iendcol, & do jlev = 1,nlev if (cloud%fraction(jcol,jlev) > 0.0_jprb) then ! Scale to get asymmetry factor and single scattering albedo - do jg = 1, config%n_bands_sw - g_sw_cloud(jg,jlev,jcol) = g_sw_cloud(jg,jlev,jcol) & - & / max(ssa_sw_cloud(jg,jlev,jcol), 1.0e-15_jprb) - ssa_sw_cloud(jg,jlev,jcol) = ssa_sw_cloud(jg,jlev,jcol) & - & / max(od_sw_cloud(jg,jlev,jcol), 1.0e-15_jprb) - end do + g_sw_cloud(:,jlev,jcol) = g_sw_cloud(:,jlev,jcol) & + & / max(ssa_sw_cloud(:,jlev,jcol), 1.0e-15_jprb) + ssa_sw_cloud(:,jlev,jcol) = ssa_sw_cloud(:,jlev,jcol) & + & / max(od_sw_cloud(:,jlev,jcol), 1.0e-15_jprb) end if end do end do @@ -287,44 +283,4 @@ subroutine general_cloud_optics(nlev,istartcol,iendcol, & end subroutine general_cloud_optics - - !--------------------------------------------------------------------- - ! Save all the cloud optics look-up tables for sw/lw and for each - ! hydrometeor type - subroutine save_general_cloud_optics(config, file_prefix, iverbose) - - use yomhook, only : lhook, dr_hook, jphook - use easy_netcdf, only : netcdf_file - use radiation_config, only : config_type - - type(config_type), intent(in) :: config - character(len=*), intent(in) :: file_prefix - integer, optional, intent(in) :: iverbose - - integer :: jtype - - real(jphook) :: hook_handle - - if (lhook) call dr_hook('radiation_general_cloud_optics:save',0,hook_handle) - - do jtype = 1,config%n_cloud_types - if (config%do_sw) then - associate(co_sw => config%cloud_optics_sw(jtype)) - call co_sw%save(file_prefix//"_sw_" & - & //trim(co_sw%type_name)//".nc", iverbose) - end associate - end if - - if (config%do_lw) then - associate(co_lw => config%cloud_optics_lw(jtype)) - call co_lw%save(file_prefix//"_lw_" & - & //trim(co_lw%type_name)//".nc", iverbose) - end associate - end if - end do - - if (lhook) call dr_hook('radiation_general_cloud_optics:save',1,hook_handle) - - end subroutine save_general_cloud_optics - end module radiation_general_cloud_optics diff --git a/radiation/radiation_general_cloud_optics_data.F90 b/radiation/radiation_general_cloud_optics_data.F90 index f62e1a11..2c72d2ae 100644 --- a/radiation/radiation_general_cloud_optics_data.F90 +++ b/radiation/radiation_general_cloud_optics_data.F90 @@ -14,8 +14,6 @@ ! License: see the COPYING file for details ! -#include "ecrad_config.h" - module radiation_general_cloud_optics_data use parkind1, only : jprb @@ -31,11 +29,11 @@ module radiation_general_cloud_optics_data type general_cloud_optics_type ! Band-specific (or g-point-specific) values as a look-up table ! versus effective radius dimensioned (nband,n_effective_radius) - + ! Extinction coefficient per unit mass (m2 kg-1) real(jprb), allocatable, dimension(:,:) :: & & mass_ext - + ! Single-scattering albedo and asymmetry factor (dimensionless) real(jprb), allocatable, dimension(:,:) :: & & ssa, asymmetry @@ -45,19 +43,18 @@ module radiation_general_cloud_optics_data integer :: n_effective_radius = 0 real(jprb) :: effective_radius_0, d_effective_radius - ! Name of cloud/precip type and scattering model - ! (e.g. "mie_droplet", "fu-muskatel_ice"). These are used to + ! Name of cloud/precip type (e.g. "liquid", "ice", "rain", "snow") + ! and the name of the optics scheme. These two are used to ! generate the name of the data file from which the coefficients ! are read. - character(len=511) :: type_name - + character(len=511) :: type_name, scheme_name + ! Do we use bands or g-points? logical :: use_bands = .false. contains procedure :: setup => setup_general_cloud_optics procedure :: add_optical_properties - procedure :: save => save_general_cloud_optics_data end type general_cloud_optics_type @@ -74,11 +71,7 @@ subroutine setup_general_cloud_optics(this, file_name, specdef, & & iverbose) use yomhook, only : lhook, dr_hook, jphook -#ifdef EASY_NETCDF_READ_MPI - use easy_netcdf_read_mpi, only : netcdf_file -#else - use easy_netcdf, only : netcdf_file -#endif + use easy_netcdf_read_mpi, only : netcdf_file use radiation_spectral_definition, only : spectral_definition_type use radiation_io, only : nulout, nulerr, radiation_abort @@ -88,7 +81,7 @@ subroutine setup_general_cloud_optics(this, file_name, specdef, & logical, intent(in), optional :: use_bands, use_thick_averaging real(jprb), intent(in), optional :: weighting_temperature ! K integer, intent(in), optional :: iverbose - + ! Spectral properties read from file, dimensioned (wavenumber, ! n_effective_radius) real(jprb), dimension(:,:), allocatable :: mass_ext, & ! m2 kg-1 @@ -189,7 +182,7 @@ subroutine setup_general_cloud_optics(this, file_name, specdef, & this%mass_ext = matmul(mapping, mass_ext) this%ssa = matmul(mapping, mass_ext*ssa) / this%mass_ext this%asymmetry = matmul(mapping, mass_ext*ssa*asymmetry) / (this%mass_ext*this%ssa) - + if (use_thick_averaging_local) then ! Thick averaging as described by Edwards and Slingo (1996), ! modifying only the single-scattering albedo @@ -268,12 +261,12 @@ subroutine add_optical_properties(this, ng, nlev, ncol, & & :: scat_od, & ! Scattering optical depth of layer & scat_asymmetry ! Scattering optical depth x asymmetry factor - real(jprb) :: od_local + real(jprb) :: od_local(ng) real(jprb) :: re_index, weight1, weight2 integer :: ire - integer :: jcol, jlev, jg + integer :: jcol, jlev real(jphook) :: hook_handle @@ -288,18 +281,15 @@ subroutine add_optical_properties(this, ng, nlev, ncol, & ire = int(re_index) weight2 = re_index - ire weight1 = 1.0_jprb - weight2 - do jg = 1, ng - od_local = water_path(jcol, jlev) * (weight1*this%mass_ext(jg,ire) & - & +weight2*this%mass_ext(jg,ire+1)) - od(jg,jlev,jcol) = od(jg,jlev,jcol) + od_local - od_local = od_local * (weight1*this%ssa(jg,ire) & - & +weight2*this%ssa(jg,ire+1)) - scat_od(jg,jlev,jcol) = scat_od(jg,jlev,jcol) + od_local - scat_asymmetry(jg,jlev,jcol) = scat_asymmetry(jg,jlev,jcol) & - & + od_local * (weight1*this%asymmetry(jg,ire) & - & +weight2*this%asymmetry(jg,ire+1)) - end do - + od_local = water_path(jcol, jlev) * (weight1*this%mass_ext(:,ire) & + & +weight2*this%mass_ext(:,ire+1)) + od(:,jlev,jcol) = od(:,jlev,jcol) + od_local + od_local = od_local * (weight1*this%ssa(:,ire) & + & +weight2*this%ssa(:,ire+1)) + scat_od(:,jlev,jcol) = scat_od(:,jlev,jcol) + od_local + scat_asymmetry(:,jlev,jcol) = scat_asymmetry(:,jlev,jcol) & + & + od_local * (weight1*this%asymmetry(:,ire) & + & +weight2*this%asymmetry(:,ire+1)) end if end do end do @@ -308,7 +298,7 @@ subroutine add_optical_properties(this, ng, nlev, ncol, & do jcol = 1,ncol do jlev = 1,nlev if (water_path(jcol, jlev) > 0.0_jprb) then - re_index = max(1.0_jprb, min(1.0_jprb + (effective_radius(jcol,jlev)-this%effective_radius_0) & + re_index = max(1.0, min(1.0_jprb + (effective_radius(jcol,jlev)-this%effective_radius_0) & & / this%d_effective_radius, this%n_effective_radius-0.0001_jprb)) ire = int(re_index) weight2 = re_index - ire @@ -351,68 +341,4 @@ elemental function calc_planck_function_wavenumber(wavenumber, temperature) end function calc_planck_function_wavenumber - !--------------------------------------------------------------------- - ! Save cloud optical properties in the named file - subroutine save_general_cloud_optics_data(this, file_name, iverbose) - - use yomhook, only : lhook, dr_hook, jphook - use easy_netcdf, only : netcdf_file - - class(general_cloud_optics_type), intent(in) :: this - character(len=*), intent(in) :: file_name - integer, optional, intent(in) :: iverbose - - ! Object for output NetCDF file - type(netcdf_file) :: out_file - - real(jprb) :: effective_radius(this%n_effective_radius) - integer :: ire - - real(jphook) :: hook_handle - - if (lhook) call dr_hook('radiation_general_cloud_optics_data:save',0,hook_handle) - - ! Create the file - call out_file%create(trim(file_name), iverbose=iverbose) - - ! Define dimensions - call out_file%define_dimension("band", size(this%mass_ext,1)) - call out_file%define_dimension("effective_radius", this%n_effective_radius) - - ! Put global attributes - call out_file%put_global_attributes( & - & title_str="Optical properties of "//trim(this%type_name) & - & //" hydrometeors using the spectral intervals of ecRad", & - & source_str="ecRad offline radiation model") - - ! Define variables - call out_file%define_variable("effective_radius", units_str="m", & - & long_name="Effective radius", dim1_name="effective_radius") - call out_file%define_variable("mass_extinction_coefficient", units_str="m2 kg-1", & - & long_name="Mass-extinction coefficient", & - & dim2_name="effective_radius", dim1_name="band") - call out_file%define_variable("single_scattering_albedo", units_str="1", & - & long_name="Single scattering albedo", & - & dim2_name="effective_radius", dim1_name="band") - call out_file%define_variable("asymmetry_factor", units_str="1", & - & long_name="Asymmetry factor", & - & dim2_name="effective_radius", dim1_name="band") - - ! Define effective radius - do ire = 1,this%n_effective_radius - effective_radius(ire) = this%effective_radius_0 + this%d_effective_radius*(ire-1) - end do - - ! Write variables - call out_file%put("effective_radius", effective_radius) - call out_file%put("mass_extinction_coefficient", this%mass_ext) - call out_file%put("single_scattering_albedo", this%ssa) - call out_file%put("asymmetry_factor", this%asymmetry) - - call out_file%close() - - if (lhook) call dr_hook('radiation_general_cloud_optics_data:save',1,hook_handle) - - end subroutine save_general_cloud_optics_data - end module radiation_general_cloud_optics_data diff --git a/radiation/radiation_ice_optics_baran2016.F90 b/radiation/radiation_ice_optics_baran2016.F90 index 732caf8c..dd146e93 100644 --- a/radiation/radiation_ice_optics_baran2016.F90 +++ b/radiation/radiation_ice_optics_baran2016.F90 @@ -1,5 +1,3 @@ -! radiation_ice_optics_baran2016.F90 - Baran et al. (2016) scheme for ice optical properties -! ! (C) Copyright 2016- ECMWF. ! ! This software is licensed under the terms of the Apache Licence Version 2.0 @@ -8,6 +6,8 @@ ! In applying this licence, ECMWF does not waive the privileges and immunities ! granted to it by virtue of its status as an intergovernmental organisation ! nor does it submit to any jurisdiction. + +! radiation_ice_optics_baran2016.f90 - Baran et al. (2016) scheme for ice optical properties ! ! Author: Robin Hogan ! Email: r.j.hogan@ecmwf.int @@ -22,7 +22,7 @@ module radiation_ice_optics_baran2016 contains - + !--------------------------------------------------------------------- ! Compute ice-particle scattering properties using a ! parameterization as a function of ice water mixing ratio and @@ -43,10 +43,10 @@ subroutine calc_ice_optics_baran2016(nb, coeff, ice_wp, & real(jprb), intent(in) :: temperature ! Total optical depth, scattering optical depth and asymmetry factor real(jprb), intent(out) :: od(nb), scat_od(nb), g(nb) - + ! Powers of temperature, some multiplied by qi real(jprb) :: qi_T, T2, qi_over_T4 - + !real(jphook) :: hook_handle !if (lhook) call dr_hook('radiation_ice_optics:calc_ice_optics_baran2016',0,hook_handle) diff --git a/radiation/radiation_ice_optics_baran2017.F90 b/radiation/radiation_ice_optics_baran2017.F90 index 5454751f..cbc31828 100644 --- a/radiation/radiation_ice_optics_baran2017.F90 +++ b/radiation/radiation_ice_optics_baran2017.F90 @@ -1,5 +1,3 @@ -! radiation_ice_optics_baran2017.F90 - 2017 parameterization of Baran's ice optical properties -! ! (C) Copyright 2017- ECMWF. ! ! This software is licensed under the terms of the Apache Licence Version 2.0 @@ -8,6 +6,8 @@ ! In applying this licence, ECMWF does not waive the privileges and immunities ! granted to it by virtue of its status as an intergovernmental organisation ! nor does it submit to any jurisdiction. + +! radiation_ice_optics_baran2017.f90 - 2017 parameterization of Baran's ice optical properties ! ! Author: Robin Hogan ! Email: r.j.hogan@ecmwf.int @@ -24,7 +24,7 @@ module radiation_ice_optics_baran2017 contains - + !--------------------------------------------------------------------- ! Compute ice-particle scattering properties using a ! parameterization as a function of ice water mixing ratio and @@ -47,10 +47,10 @@ subroutine calc_ice_optics_baran2017(nb, coeff_gen, coeff, ice_wp, & real(jprb), intent(in) :: temperature ! Total optical depth, scattering optical depth and asymmetry factor real(jprb), intent(out) :: od(nb), scat_od(nb), g(nb) - + ! Modified ice mixing ratio, and the same raised to an appropriate power real(jprb) :: qi_mod, qi_mod_od, qi_mod_ssa, qi_mod_g - + !real(jphook) :: hook_handle !if (lhook) call dr_hook('radiation_ice_optics:calc_ice_optics_baran2017',0,hook_handle) diff --git a/radiation/radiation_ice_optics_yi.F90 b/radiation/radiation_ice_optics_yi.F90 index f3617c84..ad7fd3e4 100644 --- a/radiation/radiation_ice_optics_yi.F90 +++ b/radiation/radiation_ice_optics_yi.F90 @@ -1,5 +1,3 @@ -! radiation_ice_optics_yi.F90 - Yi et al. (2013) ice optical properties -! ! (C) Copyright 2017- ECMWF. ! ! This software is licensed under the terms of the Apache Licence Version 2.0 @@ -8,6 +6,8 @@ ! In applying this licence, ECMWF does not waive the privileges and immunities ! granted to it by virtue of its status as an intergovernmental organisation ! nor does it submit to any jurisdiction. + +! radiation_ice_optics_yi.F90 - Yi et al. (2013) ice optical properties ! ! Authors: Mark Fielding and Robin Hogan ! Email: r.j.hogan@ecmwf.int @@ -78,9 +78,9 @@ subroutine calc_ice_optics_yi_sw(nb, coeff, ice_wp, & lu_idx = floor(de_um * lu_scale - lu_offset) wts_2 = (de_um * lu_scale - lu_offset) - lu_idx wts_1 = 1.0_jprb - wts_2 - od = 0.001_jprb * iwp_gm_2 * & + od = 0.001_jprb * iwp_gm_2 * & & ( wts_1 * coeff(1:nb,lu_idx) + wts_2 * coeff(1:nb,lu_idx+1) ) - scat_od = od * & + scat_od = od * & & ( wts_1 * coeff(1:nb,lu_idx+NSingleCoeffs) + wts_2 * coeff(1:nb,lu_idx+NSingleCoeffs+1) ) g = wts_1 * coeff(1:nb,lu_idx+2*NSingleCoeffs) + wts_2 * coeff(1:nb,lu_idx+2*NSingleCoeffs+1) @@ -135,9 +135,9 @@ subroutine calc_ice_optics_yi_lw(nb, coeff, ice_wp, & lu_idx = floor(de_um * lu_scale - lu_offset) wts_2 = (de_um * lu_scale - lu_offset) - lu_idx wts_1 = 1.0_jprb - wts_2 - od = 0.001_jprb * iwp_gm_2 * & + od = 0.001_jprb * iwp_gm_2 * & & ( wts_1 * coeff(1:nb,lu_idx) + wts_2 * coeff(1:nb,lu_idx+1) ) - scat_od = od * & + scat_od = od * & & ( wts_1 * coeff(1:nb,lu_idx+NSingleCoeffs) + wts_2 * coeff(1:nb,lu_idx+NSingleCoeffs+1) ) g = wts_1 * coeff(1:nb,lu_idx+2*NSingleCoeffs) + wts_2 * coeff(1:nb,lu_idx+2*NSingleCoeffs+1) diff --git a/radiation/radiation_ifs_rrtm.F90 b/radiation/radiation_ifs_rrtm.F90 index f5e06922..c5c3c197 100644 --- a/radiation/radiation_ifs_rrtm.F90 +++ b/radiation/radiation_ifs_rrtm.F90 @@ -20,6 +20,7 @@ ! 2018-02-22 R. Hogan Optimized reverse indexing of heights ! 2018-05-05 R. Hogan gas_optics can be called for reduced number of levels ! 2019-01-02 R. Hogan Initialize shortwave props to zero in case sun below horizon +! 2025-08-06 R. El Khatib Optimization module radiation_ifs_rrtm @@ -40,8 +41,6 @@ subroutine setup_gas_optics(config, directory) use yomhook, only : lhook, dr_hook, jphook use radiation_config - use radiation_spectral_definition, only & - & : SolarReferenceTemperature, TerrestrialReferenceTemperature type(config_type), intent(inout), target :: config character(len=*), intent(in) :: directory @@ -66,8 +65,6 @@ subroutine setup_gas_optics(config, directory) & 52, 5, 98, 10, 42, 99, 100, 66, 11, 74, 34, 53, 26, 6, 106, 12, 43, 13, 54, 93, & & 44, 107, 94, 14, 108, 15, 16, 109, 17, 18, 110, 111, 112 & & /) - - logical :: do_sw, do_lw real(jphook) :: hook_handle @@ -80,9 +77,6 @@ subroutine setup_gas_optics(config, directory) if (lhook) call dr_hook('radiation_ifs_rrtm:setup_gas_optics',0,hook_handle) - do_sw = (config%do_sw .and. config%i_gas_model_sw == IGasModelIFSRRTMG) - do_lw = (config%do_lw .and. config%i_gas_model_lw == IGasModelIFSRRTMG) - ! The IFS implementation of RRTMG uses many global variables. In ! the IFS these will have been set up already; otherwise set them ! up now. @@ -91,108 +85,90 @@ subroutine setup_gas_optics(config, directory) call SURRTAB call SURRTPK call SURRTRF - if (do_lw) then - call RRTM_INIT_140GP(directory) - end if - if (do_sw) then - call SRTM_INIT(directory) - end if + call RRTM_INIT_140GP(directory) + call SRTM_INIT(directory) end if - if (do_sw) then - - ! Cloud and aerosol properties can only be defined per band - config%do_cloud_aerosol_per_sw_g_point = .false. - config%n_g_sw = jpgsw - config%n_bands_sw = 14 - ! Wavenumber ranges of each band may be needed so that the user - ! can compute UV and photosynthetically active radiation for a - ! particular wavelength range - call config%gas_optics_sw%spectral_def%allocate_bands_only(SolarReferenceTemperature, & - & [2600.0_jprb, 3250.0_jprb, 4000.0_jprb, 4650.0_jprb, 5150.0_jprb, 6150.0_jprb, 7700.0_jprb, & - & 8050.0_jprb, 12850.0_jprb, 16000.0_jprb, 22650.0_jprb, 29000.0_jprb, 38000.0_jprb, 820.0_jprb], & - & [3250.0_jprb, 4000.0_jprb, 4650.0_jprb, 5150.0_jprb, 6150.0_jprb, 7700.0_jprb, 8050.0_jprb, & - & 12850.0_jprb, 16000.0_jprb, 22650.0_jprb, 29000.0_jprb, 38000.0_jprb, 50000.0_jprb, 2600.0_jprb]) - allocate(config%i_band_from_g_sw (config%n_g_sw)) - allocate(config%i_band_from_reordered_g_sw(config%n_g_sw)) - allocate(config%i_g_from_reordered_g_sw (config%n_g_sw)) - ! Shortwave starts at 16: need to start at 1 - config%i_band_from_g_sw = ngb_sw - ngb_sw(1)+1 - - if (config%i_solver_sw == ISolverSpartacus) then - ! SPARTACUS requires g points ordered in approximately - ! increasing order of optical depth - config%i_g_from_reordered_g_sw = RRTM_GPOINT_REORDERING_SW - else - ! Implied-do for no reordering - ! config%i_g_from_reordered_g_sw = RRTM_GPOINT_REORDERING_SW - config%i_g_from_reordered_g_sw = (/ (irep, irep=1,config%n_g_sw) /) - end if - - config%i_band_from_reordered_g_sw & - = config%i_band_from_g_sw(config%i_g_from_reordered_g_sw) - - ! The i_spec_* variables are used solely for storing spectral - ! data, and this can either be by band or by g-point - if (config%do_save_spectral_flux .or. config%do_toa_spectral_flux) then - if (config%do_save_gpoint_flux) then - config%n_spec_sw = config%n_g_sw - config%i_spec_from_reordered_g_sw => config%i_g_from_reordered_g_sw - else - config%n_spec_sw = config%n_bands_sw - config%i_spec_from_reordered_g_sw => config%i_band_from_reordered_g_sw - end if - else - config%n_spec_sw = 0 - nullify(config%i_spec_from_reordered_g_sw) - end if - + ! Cloud and aerosol properties can only be defined per band + config%do_cloud_aerosol_per_sw_g_point = .false. + config%do_cloud_aerosol_per_lw_g_point = .false. + + config%n_g_sw = jpgsw + config%n_g_lw = jpglw + config%n_bands_sw = 14 + config%n_bands_lw = 16 + + ! Wavenumber ranges of each band may be needed so that the user + ! can compute UV and photosynthetically active radiation for a + ! particular wavelength range + call config%gas_optics_sw%spectral_def%allocate_bands_only( & + & [2600.0_jprb, 3250.0_jprb, 4000.0_jprb, 4650.0_jprb, 5150.0_jprb, 6150.0_jprb, 7700.0_jprb, & + & 8050.0_jprb, 12850.0_jprb, 16000.0_jprb, 22650.0_jprb, 29000.0_jprb, 38000.0_jprb, 820.0_jprb], & + & [3250.0_jprb, 4000.0_jprb, 4650.0_jprb, 5150.0_jprb, 6150.0_jprb, 7700.0_jprb, 8050.0_jprb, & + & 12850.0_jprb, 16000.0_jprb, 22650.0_jprb, 29000.0_jprb, 38000.0_jprb, 50000.0_jprb, 2600.0_jprb]) + call config%gas_optics_lw%spectral_def%allocate_bands_only( & + & [10.0_jprb, 350.0_jprb, 500.0_jprb, 630.0_jprb, 700.0_jprb, 820.0_jprb, 980.0_jprb, 1080.0_jprb, & + & 1180.0_jprb, 1390.0_jprb, 1480.0_jprb, 1800.0_jprb, 2080.0_jprb, 2250.0_jprb, 2380.0_jprb, 2600.0_jprb], & + & [350.0_jprb, 500.0_jprb, 630.0_jprb, 700.0_jprb, 820.0_jprb, 980.0_jprb, 1080.0_jprb, 1180.0_jprb, & + & 1390.0_jprb, 1480.0_jprb, 1800.0_jprb, 2080.0_jprb, 2250.0_jprb, 2380.0_jprb, 2600.0_jprb, 3250.0_jprb]) + + allocate(config%i_band_from_g_sw (config%n_g_sw)) + allocate(config%i_band_from_g_lw (config%n_g_lw)) + allocate(config%i_band_from_reordered_g_sw(config%n_g_sw)) + allocate(config%i_band_from_reordered_g_lw(config%n_g_lw)) + allocate(config%i_g_from_reordered_g_sw(config%n_g_sw)) + allocate(config%i_g_from_reordered_g_lw(config%n_g_lw)) + + ! Shortwave starts at 16: need to start at 1 + config%i_band_from_g_sw = ngb_sw - ngb_sw(1)+1 + config%i_band_from_g_lw = ngb_lw + + if (config%i_solver_sw == ISolverSpartacus) then + ! SPARTACUS requires g points ordered in approximately + ! increasing order of optical depth + config%i_g_from_reordered_g_sw = RRTM_GPOINT_REORDERING_SW + else + ! Implied-do for no reordering +! config%i_g_from_reordered_g_sw = RRTM_GPOINT_REORDERING_SW + config%i_g_from_reordered_g_sw = (/ (irep, irep=1,config%n_g_sw) /) end if - if (do_lw) then - ! Cloud and aerosol properties can only be defined per band - config%do_cloud_aerosol_per_lw_g_point = .false. - config%n_g_lw = jpglw - config%n_bands_lw = 16 - call config%gas_optics_lw%spectral_def%allocate_bands_only(TerrestrialReferenceTemperature, & - & [10.0_jprb, 350.0_jprb, 500.0_jprb, 630.0_jprb, 700.0_jprb, 820.0_jprb, 980.0_jprb, 1080.0_jprb, & - & 1180.0_jprb, 1390.0_jprb, 1480.0_jprb, 1800.0_jprb, 2080.0_jprb, 2250.0_jprb, 2380.0_jprb, 2600.0_jprb], & - & [350.0_jprb, 500.0_jprb, 630.0_jprb, 700.0_jprb, 820.0_jprb, 980.0_jprb, 1080.0_jprb, 1180.0_jprb, & - & 1390.0_jprb, 1480.0_jprb, 1800.0_jprb, 2080.0_jprb, 2250.0_jprb, 2380.0_jprb, 2600.0_jprb, 3250.0_jprb]) - allocate(config%i_band_from_g_lw (config%n_g_lw)) - allocate(config%i_band_from_reordered_g_lw(config%n_g_lw)) - allocate(config%i_g_from_reordered_g_lw (config%n_g_lw)) - config%i_band_from_g_lw = ngb_lw + if (config%i_solver_lw == ISolverSpartacus) then + ! SPARTACUS requires g points ordered in approximately + ! increasing order of optical depth + config%i_g_from_reordered_g_lw = RRTM_GPOINT_REORDERING_LW + else + ! Implied-do for no reordering + config%i_g_from_reordered_g_lw = (/ (irep, irep=1,config%n_g_lw) /) + end if - if (config%i_solver_lw == ISolverSpartacus) then - ! SPARTACUS requires g points ordered in approximately - ! increasing order of optical depth - config%i_g_from_reordered_g_lw = RRTM_GPOINT_REORDERING_LW - else - ! Implied-do for no reordering - config%i_g_from_reordered_g_lw = (/ (irep, irep=1,config%n_g_lw) /) - end if + config%i_band_from_reordered_g_sw & + = config%i_band_from_g_sw(config%i_g_from_reordered_g_sw) - config%i_band_from_reordered_g_lw & - = config%i_band_from_g_lw(config%i_g_from_reordered_g_lw) + config%i_band_from_reordered_g_lw & + = config%i_band_from_g_lw(config%i_g_from_reordered_g_lw) - ! The i_spec_* variables are used solely for storing spectral - ! data, and this can either be by band or by g-point - if (config%do_save_spectral_flux .or. config%do_toa_spectral_flux) then - if (config%do_save_gpoint_flux) then - config%n_spec_lw = config%n_g_lw - config%i_spec_from_reordered_g_lw => config%i_g_from_reordered_g_lw - else - config%n_spec_lw = config%n_bands_lw - config%i_spec_from_reordered_g_lw => config%i_band_from_reordered_g_lw - end if + ! The i_spec_* variables are used solely for storing spectral + ! data, and this can either be by band or by g-point + if (config%do_save_spectral_flux .or. config%do_toa_spectral_flux) then + if (config%do_save_gpoint_flux) then + config%n_spec_sw = config%n_g_sw + config%n_spec_lw = config%n_g_lw + config%i_spec_from_reordered_g_sw => config%i_g_from_reordered_g_sw + config%i_spec_from_reordered_g_lw => config%i_g_from_reordered_g_lw else - config%n_spec_lw = 0 - nullify(config%i_spec_from_reordered_g_lw) + config%n_spec_sw = config%n_bands_sw + config%n_spec_lw = config%n_bands_lw + config%i_spec_from_reordered_g_sw => config%i_band_from_reordered_g_sw + config%i_spec_from_reordered_g_lw => config%i_band_from_reordered_g_lw end if - + else + config%n_spec_sw = 0 + config%n_spec_lw = 0 + nullify(config%i_spec_from_reordered_g_sw) + nullify(config%i_spec_from_reordered_g_lw) end if - + if (lhook) call dr_hook('radiation_ifs_rrtm:setup_gas_optics',1,hook_handle) end subroutine setup_gas_optics @@ -225,7 +201,7 @@ subroutine gas_optics(ncol,nlev,istartcol,iendcol, & USE YOESRTM , ONLY : JPGPT_SW => JPGPT use yomhook , only : lhook, dr_hook, jphook - use radiation_config, only : config_type, ISolverSpartacus, IGasModelIFSRRTMG + use radiation_config, only : config_type, ISolverSpartacus use radiation_thermodynamics, only : thermodynamics_type use radiation_single_level, only : single_level_type use radiation_gas @@ -358,8 +334,6 @@ subroutine gas_optics(ncol,nlev,istartcol,iendcol, & ! layer are provided, useful for canopy radiative transfer. integer :: istartlev, iendlev - logical :: do_sw, do_lw - integer :: jlev, jgreorder, jg, ig, iband, jcol real(jphook) :: hook_handle @@ -372,9 +346,6 @@ subroutine gas_optics(ncol,nlev,istartcol,iendcol, & if (lhook) call dr_hook('radiation_ifs_rrtm:gas_optics',0,hook_handle) - do_sw = (config%do_sw .and. config%i_gas_model_sw == IGasModelIFSRRTMG) - do_lw = (config%do_lw .and. config%i_gas_model_lw == IGasModelIFSRRTMG) - ! Compute start and end levels for indexing the gas mixing ratio ! and thermodynamics arrays iendlev = ubound(gas%mixing_ratio,2) @@ -421,191 +392,181 @@ subroutine gas_optics(ncol,nlev,istartcol,iendcol, & & ZCOLDRY, ZWBRODL,ZWKL, ZWX, & & ZPAVEL , ZTAVEL , ZPZ , ZTZ, IREFLECT) - if (do_lw) then - - CALL RRTM_SETCOEF_140GP & - &( istartcol, iendcol, nlev , ZCOLDRY , ZWBRODL , ZWKL , & - & ZFAC00 , ZFAC01 , ZFAC10 , ZFAC11 , ZFORFAC,ZFORFRAC,INDFOR, JP, JT, JT1 , & - & ZCOLH2O, ZCOLCO2 , ZCOLO3 , ZCOLN2O, ZCOLCH4, ZCOLO2,ZCO2MULT , ZCOLBRD, & - & ILAYTROP,ILAYSWTCH, ILAYLOW, ZPAVEL , ZTAVEL , ZSELFFAC, ZSELFFRAC, INDSELF, & - & INDMINOR,ZSCALEMINOR,ZSCALEMINORN2,ZMINORFRAC,& - & ZRAT_H2OCO2, ZRAT_H2OCO2_1, ZRAT_H2OO3, ZRAT_H2OO3_1, & - & ZRAT_H2ON2O, ZRAT_H2ON2O_1, ZRAT_H2OCH4, ZRAT_H2OCH4_1, & - & ZRAT_N2OCO2, ZRAT_N2OCO2_1, ZRAT_O3CO2, ZRAT_O3CO2_1) - - ZTAUAERL(istartcol:iendcol,:,:) = 0.0_jprb - - CALL RRTM_GAS_OPTICAL_DEPTH & - &( istartcol, iendcol, nlev, ZOD_LW, ZPAVEL, ZCOLDRY, ZCOLBRD, ZWX ,& - & ZTAUAERL, ZFAC00 , ZFAC01, ZFAC10 , ZFAC11 , ZFORFAC,ZFORFRAC,INDFOR, & - & JP, JT, JT1, ZONEMINUS ,& - & ZCOLH2O , ZCOLCO2, ZCOLO3, ZCOLN2O, ZCOLCH4, ZCOLO2,ZCO2MULT ,& - & ILAYTROP, ILAYSWTCH,ILAYLOW, ZSELFFAC, ZSELFFRAC, INDSELF, ZPFRAC, & - & INDMINOR,ZSCALEMINOR,ZSCALEMINORN2,ZMINORFRAC,& - & ZRAT_H2OCO2, ZRAT_H2OCO2_1, ZRAT_H2OO3, ZRAT_H2OO3_1, & - & ZRAT_H2ON2O, ZRAT_H2ON2O_1, ZRAT_H2OCH4, ZRAT_H2OCH4_1, & - & ZRAT_N2OCO2, ZRAT_N2OCO2_1, ZRAT_O3CO2, ZRAT_O3CO2_1) + CALL RRTM_SETCOEF_140GP & + &( istartcol, iendcol, nlev , ZCOLDRY , ZWBRODL , ZWKL , & + & ZFAC00 , ZFAC01 , ZFAC10 , ZFAC11 , ZFORFAC,ZFORFRAC,INDFOR, JP, JT, JT1 , & + & ZCOLH2O, ZCOLCO2 , ZCOLO3 , ZCOLN2O, ZCOLCH4, ZCOLO2,ZCO2MULT , ZCOLBRD, & + & ILAYTROP,ILAYSWTCH, ILAYLOW, ZPAVEL , ZTAVEL , ZSELFFAC, ZSELFFRAC, INDSELF, & + & INDMINOR,ZSCALEMINOR,ZSCALEMINORN2,ZMINORFRAC,& + & ZRAT_H2OCO2, ZRAT_H2OCO2_1, ZRAT_H2OO3, ZRAT_H2OO3_1, & + & ZRAT_H2ON2O, ZRAT_H2ON2O_1, ZRAT_H2OCH4, ZRAT_H2OCH4_1, & + & ZRAT_N2OCO2, ZRAT_N2OCO2_1, ZRAT_O3CO2, ZRAT_O3CO2_1) + + ZTAUAERL(istartcol:iendcol,:,:) = 0.0_jprb + + CALL RRTM_GAS_OPTICAL_DEPTH & + &( istartcol, iendcol, nlev, ZOD_LW, ZPAVEL, ZCOLDRY, ZCOLBRD, ZWX ,& + & ZTAUAERL, ZFAC00 , ZFAC01, ZFAC10 , ZFAC11 , ZFORFAC,ZFORFRAC,INDFOR, & + & JP, JT, JT1, ZONEMINUS ,& + & ZCOLH2O , ZCOLCO2, ZCOLO3, ZCOLN2O, ZCOLCH4, ZCOLO2,ZCO2MULT ,& + & ILAYTROP, ILAYSWTCH,ILAYLOW, ZSELFFAC, ZSELFFRAC, INDSELF, ZPFRAC, & + & INDMINOR,ZSCALEMINOR,ZSCALEMINORN2,ZMINORFRAC,& + & ZRAT_H2OCO2, ZRAT_H2OCO2_1, ZRAT_H2OO3, ZRAT_H2OO3_1, & + & ZRAT_H2ON2O, ZRAT_H2ON2O_1, ZRAT_H2OCH4, ZRAT_H2OCH4_1, & + & ZRAT_N2OCO2, ZRAT_N2OCO2_1, ZRAT_O3CO2, ZRAT_O3CO2_1) + + if (present(lw_albedo)) then - if (present(lw_albedo)) then - - call planck_function_atmos(nlev, istartcol, iendcol, config, & - & thermodynamics, ZPFRAC, planck_hl) - - if (single_level%is_simple_surface) then - call planck_function_surf(istartcol, iendcol, config, & - & single_level%skin_temperature, ZPFRAC(:,:,1), & - & lw_emission) - - ! The following can be used to extract the parameters defined at - ! the top of the planck_function routine below: - !write(*,'(a,140(e12.5,","),a)') 'ZPFRAC_surf=[', & - !& sum(ZPFRAC(istartcol:iendcol,:,1),1) / (iendcol+1-istartcol), ']' + call planck_function_atmos(nlev, istartcol, iendcol, config, & + & thermodynamics, ZPFRAC, planck_hl) + + if (single_level%is_simple_surface) then + call planck_function_surf(istartcol, iendcol, config, & + & single_level%skin_temperature, ZPFRAC(:,:,1), & + & lw_emission) + + ! The following can be used to extract the parameters defined at + ! the top of the planck_function routine below: + !write(*,'(a,140(e12.5,","),a)') 'ZPFRAC_surf=[', & + !& sum(ZPFRAC(istartcol:iendcol,:,1),1) / (iendcol+1-istartcol), ']' - ! lw_emission at this point is actually the planck function of - ! the surface - lw_emission = lw_emission * (1.0_jprb - lw_albedo) + ! lw_emission at this point is actually the planck function of + ! the surface + lw_emission = lw_emission * (1.0_jprb - lw_albedo) + else + ! Longwave emission has already been computed + if (config%use_canopy_full_spectrum_lw) then + lw_emission = transpose(single_level%lw_emission(istartcol:iendcol,:)) else - ! Longwave emission has already been computed - if (config%use_canopy_full_spectrum_lw) then - lw_emission = transpose(single_level%lw_emission(istartcol:iendcol,:)) - else - lw_emission = transpose(single_level%lw_emission(istartcol:iendcol, & - & config%i_emiss_from_band_lw(config%i_band_from_reordered_g_lw))) - end if + lw_emission = transpose(single_level%lw_emission(istartcol:iendcol, & + & config%i_emiss_from_band_lw(config%i_band_from_reordered_g_lw))) end if - end if - if (config%i_solver_lw == ISolverSpartacus) then - ! We need to rearrange the gas optics info in memory: reordering - ! the g points in order of approximately increasing optical - ! depth (for efficient 3D processing on only the regions of the - ! spectrum that are optically thin for gases) and reorder in - ! pressure since the the functions above treat pressure - ! decreasing with increasing index. Note that the output gas - ! arrays have dimensions in a different order to the inputs, - ! so there is some inefficiency here. - do jgreorder = 1,config%n_g_lw - iband = config%i_band_from_reordered_g_lw(jgreorder) - ig = config%i_g_from_reordered_g_lw(jgreorder) - - ! Top-of-atmosphere half level - do jlev = 1,nlev - do jcol = istartcol,iendcol - ! Some g points can return negative optical depths; - ! specifically original g points 54-56 which causes - ! unphysical single-scattering albedo when combined with - ! aerosol - od_lw(jgreorder,jlev,jcol) & - & = max(config%min_gas_od_lw, ZOD_LW(ig,nlev+1-jlev,jcol)) - end do + end if + + if (config%i_solver_lw == ISolverSpartacus) then + ! We need to rearrange the gas optics info in memory: reordering + ! the g points in order of approximately increasing optical + ! depth (for efficient 3D processing on only the regions of the + ! spectrum that are optically thin for gases) and reorder in + ! pressure since the the functions above treat pressure + ! decreasing with increasing index. Note that the output gas + ! arrays have dimensions in a different order to the inputs, + ! so there is some inefficiency here. + do jgreorder = 1,config%n_g_lw + iband = config%i_band_from_reordered_g_lw(jgreorder) + ig = config%i_g_from_reordered_g_lw(jgreorder) + + ! Top-of-atmosphere half level + do jlev = 1,nlev + do jcol = istartcol,iendcol + ! Some g points can return negative optical depths; + ! specifically original g points 54-56 which causes + ! unphysical single-scattering albedo when combined with + ! aerosol + od_lw(jgreorder,jlev,jcol) & + & = max(config%min_gas_od_lw, ZOD_LW(ig,nlev+1-jlev,jcol)) end do end do - else - ! G points have not been reordered - do jcol = istartcol,iendcol - do jlev = 1,nlev - ! Check for negative optical depth - od_lw(:,jlev,jcol) = max(config%min_gas_od_lw, ZOD_LW(:,nlev+1-jlev,jcol)) - end do + end do + else + ! G points have not been reordered + do jcol = istartcol,iendcol + do jlev = 1,nlev + ! Check for negative optical depth + od_lw(:,jlev,jcol) = max(config%min_gas_od_lw, ZOD_LW(:,nlev+1-jlev,jcol)) end do - end if - + end do end if - - if (do_sw) then - CALL SRTM_SETCOEF & - & ( istartcol, iendcol, nlev,& - & ZPAVEL , ZTAVEL,& - & ZCOLDRY , ZWKL,& - & ILAYTROP,& - & ZCOLCH4 , ZCOLCO2 , ZCOLH2O , ZCOLMOL , ZCOLO2 , ZCOLO3,& - & ZFORFAC , ZFORFRAC , INDFOR , ZSELFFAC, ZSELFFRAC, INDSELF, & - & ZFAC00 , ZFAC01 , ZFAC10 , ZFAC11,& - & JP , JT , JT1 , single_level%cos_sza(istartcol:iendcol) & - & ) + CALL SRTM_SETCOEF & + & ( istartcol, iendcol, nlev,& + & ZPAVEL , ZTAVEL,& + & ZCOLDRY , ZWKL,& + & ILAYTROP,& + & ZCOLCH4 , ZCOLCO2 , ZCOLH2O , ZCOLMOL , ZCOLO2 , ZCOLO3,& + & ZFORFAC , ZFORFRAC , INDFOR , ZSELFFAC, ZSELFFRAC, INDSELF, & + & ZFAC00 , ZFAC01 , ZFAC10 , ZFAC11,& + & JP , JT , JT1 , single_level%cos_sza(istartcol:iendcol) & + & ) - ! SRTM_GAS_OPTICAL_DEPTH will not initialize profiles when the sun - ! is below the horizon, so we do it here - ZOD_SW(istartcol:iendcol,:,:) = 0.0_jprb - ZSSA_SW(istartcol:iendcol,:,:) = 0.0_jprb - ZINCSOL(istartcol:iendcol,:) = 0.0_jprb - - CALL SRTM_GAS_OPTICAL_DEPTH & - &( istartcol, iendcol , nlev , ZONEMINUS_ARRAY,& - & single_level%cos_sza(istartcol:iendcol), ILAYTROP,& - & ZCOLCH4 , ZCOLCO2 , ZCOLH2O, ZCOLMOL , ZCOLO2 , ZCOLO3,& - & ZFORFAC , ZFORFRAC , INDFOR , ZSELFFAC, ZSELFFRAC, INDSELF,& - & ZFAC00 , ZFAC01 , ZFAC10 , ZFAC11 ,& - & JP , JT , JT1 ,& - & ZOD_SW , ZSSA_SW , ZINCSOL ) + ! SRTM_GAS_OPTICAL_DEPTH will not initialize profiles when the sun + ! is below the horizon, so we do it here + ZOD_SW(istartcol:iendcol,:,:) = 0.0_jprb + ZSSA_SW(istartcol:iendcol,:,:) = 0.0_jprb + ZINCSOL(istartcol:iendcol,:) = 0.0_jprb + + CALL SRTM_GAS_OPTICAL_DEPTH & + &( istartcol, iendcol , nlev , ZONEMINUS_ARRAY,& + & single_level%cos_sza(istartcol:iendcol), ILAYTROP,& + & ZCOLCH4 , ZCOLCO2 , ZCOLH2O, ZCOLMOL , ZCOLO2 , ZCOLO3,& + & ZFORFAC , ZFORFRAC , INDFOR , ZSELFFAC, ZSELFFRAC, INDSELF,& + & ZFAC00 , ZFAC01 , ZFAC10 , ZFAC11 ,& + & JP , JT , JT1 ,& + & ZOD_SW , ZSSA_SW , ZINCSOL ) - ! Scale the incoming solar per band, if requested - if (config%use_spectral_solar_scaling) then - do jg = 1,JPGPT_SW - do jcol = istartcol,iendcol - ZINCSOL(jcol,jg) = ZINCSOL(jcol,jg) * & - & single_level%spectral_solar_scaling(config%i_band_from_reordered_g_sw(jg)) - end do + ! Scale the incoming solar per band, if requested + if (config%use_spectral_solar_scaling) then + do jg = 1,JPGPT_SW + do jcol = istartcol,iendcol + ZINCSOL(jcol,jg) = ZINCSOL(jcol,jg) * & + & single_level%spectral_solar_scaling(config%i_band_from_reordered_g_sw(jg)) end do - end if + end do + end if - ! Scaling factor to ensure that the total solar irradiance is as - ! requested. Note that if the sun is below the horizon then - ! ZINCSOL will be zero. - if (present(incoming_sw)) then - do jcol = istartcol,iendcol - if (single_level%cos_sza(jcol) > 0.0_jprb) then + ! Scaling factor to ensure that the total solar irradiance is as + ! requested. Note that if the sun is below the horizon then + ! ZINCSOL will be zero. + if (present(incoming_sw)) then + do jcol = istartcol,iendcol + if (single_level%cos_sza(jcol) > 0.0_jprb) then ! Added for DWD (2020) !NEC$ nounroll - incoming_sw_scale(jcol) = single_level%solar_irradiance / sum(ZINCSOL(jcol,:)) - else - incoming_sw_scale(jcol) = 1.0_jprb - end if - end do - end if + incoming_sw_scale(jcol) = single_level%solar_irradiance / sum(ZINCSOL(jcol,:)) + else + incoming_sw_scale(jcol) = 1.0_jprb + end if + end do + end if - if (config%i_solver_sw == ISolverSpartacus) then -! if (.true.) then - ! Account for reordered g points - do jgreorder = 1,config%n_g_sw - ig = config%i_g_from_reordered_g_sw(jgreorder) - do jlev = 1,nlev - do jcol = istartcol,iendcol - ! Check for negative optical depth - od_sw (jgreorder,nlev+1-jlev,jcol) & - & = max(config%min_gas_od_sw, ZOD_SW (jcol,jlev,ig)) - ssa_sw(jgreorder,nlev+1-jlev,jcol) = ZSSA_SW(jcol,jlev,ig) - end do - end do - if (present(incoming_sw)) then - incoming_sw(jgreorder,:) & - & = incoming_sw_scale(:) * ZINCSOL(:,ig) - end if + if (config%i_solver_sw == ISolverSpartacus) then +! if (.true.) then + ! Account for reordered g points + do jgreorder = 1,config%n_g_sw + ig = config%i_g_from_reordered_g_sw(jgreorder) + do jlev = 1,nlev + do jcol = istartcol,iendcol + ! Check for negative optical depth + od_sw (jgreorder,nlev+1-jlev,jcol) & + & = max(config%min_gas_od_sw, ZOD_SW (jcol,jlev,ig)) + ssa_sw(jgreorder,nlev+1-jlev,jcol) = ZSSA_SW(jcol,jlev,ig) + end do end do - else - ! G points have not been reordered - do jcol = istartcol,iendcol - do jlev = 1,nlev - do jg = 1,config%n_g_sw - ! Check for negative optical depth - od_sw (jg,nlev+1-jlev,jcol) = max(config%min_gas_od_sw, ZOD_SW(jcol,jlev,jg)) - ssa_sw(jg,nlev+1-jlev,jcol) = ZSSA_SW(jcol,jlev,jg) - end do + if (present(incoming_sw)) then + incoming_sw(jgreorder,:) & + & = incoming_sw_scale(:) * ZINCSOL(:,ig) + end if + end do + else + ! G points have not been reordered + do jg = 1,config%n_g_sw + do jlev = 1,nlev + do jcol = istartcol,iendcol + ! Check for negative optical depth + od_sw (jg,nlev+1-jlev,jcol) = max(config%min_gas_od_sw, ZOD_SW(jcol,jlev,jg)) + ssa_sw(jg,nlev+1-jlev,jcol) = ZSSA_SW(jcol,jlev,jg) end do end do - - if (present(incoming_sw)) then + end do + if (present(incoming_sw)) then + do jg = 1,config%n_g_sw do jcol = istartcol,iendcol - do jg = 1,config%n_g_sw - incoming_sw(jg,jcol) = incoming_sw_scale(jcol) * ZINCSOL(jcol,jg) - end do + incoming_sw(jg,jcol) = incoming_sw_scale(jcol) * ZINCSOL(jcol,jg) end do - end if - + end do end if - end if if (lhook) call dr_hook('radiation_ifs_rrtm:gas_optics',1,hook_handle) diff --git a/radiation/radiation_interface.F90 b/radiation/radiation_interface.F90 index 2b413ee3..293cac36 100644 --- a/radiation/radiation_interface.F90 +++ b/radiation/radiation_interface.F90 @@ -67,18 +67,12 @@ subroutine setup_radiation(config) call config%consolidate() ! Load the look-up tables from files in the specified directory - if (config%i_gas_model_sw == IGasModelMonochromatic) then + if (config%i_gas_model == IGasModelMonochromatic) then call setup_gas_optics_mono(config, trim(config%directory_name)) - else - ! Note that we can run RRTMG and ECCKD for different parts of - ! the spectrum: the setup routines only configure the relevant - ! part. - if (config%i_gas_model_sw == IGasModelIFSRRTMG .or. config%i_gas_model_lw == IGasModelIFSRRTMG) then - call setup_gas_optics_rrtmg(config, trim(config%directory_name)) - end if - if (config%i_gas_model_sw == IGasModelECCKD .or. config%i_gas_model_lw == IGasModelECCKD) then - call setup_gas_optics_ecckd(config) - end if + else if (config%i_gas_model == IGasModelIFSRRTMG) then + call setup_gas_optics_rrtmg(config, trim(config%directory_name)) + else if (config%i_gas_model == IGasModelECCKD) then + call setup_gas_optics_ecckd(config) end if if (config%do_lw_aerosol_scattering & @@ -127,7 +121,7 @@ subroutine setup_radiation(config) end if if (config%do_clouds) then - if (config%i_gas_model_sw == IGasModelMonochromatic) then + if (config%i_gas_model == IGasModelMonochromatic) then ! call setup_cloud_optics_mono(config) elseif (config%use_general_cloud_optics) then call setup_general_cloud_optics(config) @@ -137,7 +131,7 @@ subroutine setup_radiation(config) end if if (config%use_aerosols) then - if (config%i_gas_model_sw == IGasModelMonochromatic) then + if (config%i_gas_model == IGasModelMonochromatic) then ! call setup_aerosol_optics_mono(config) else call setup_aerosol_optics(config) @@ -172,16 +166,12 @@ subroutine set_gas_units(config, gas) type(config_type), intent(in) :: config type(gas_type), intent(inout) :: gas - if (config%i_gas_model_sw == IGasModelMonochromatic) then + if (config%i_gas_model == IGasModelMonochromatic) then call set_gas_units_mono(gas) - elseif (config%i_gas_model_sw == IGasModelIFSRRTMG & - & .or. config%i_gas_model_lw == IGasModelIFSRRTMG) then - ! Convert to mass-mixing ratio for RRTMG; note that ecCKD can - ! work with this but performs an internal scaling - call set_gas_units_ifs(gas) - else - ! Use volume mixing ratio preferred by ecCKD + elseif (config%i_gas_model == IGasModelECCKD) then call set_gas_units_ecckd(gas) + else + call set_gas_units_ifs(gas) end if end subroutine set_gas_units @@ -205,7 +195,7 @@ subroutine radiation(ncol, nlev, istartcol, iendcol, config, & use radiation_io, only : nulout use radiation_config, only : config_type, & - & IGasModelMonochromatic, IGasModelIFSRRTMG, IGasModelECCKD, & + & IGasModelMonochromatic, IGasModelIFSRRTMG, & & ISolverMcICA, ISolverSpartacus, ISolverHomogeneous, & & ISolverTripleclouds use radiation_single_level, only : single_level_type @@ -330,28 +320,23 @@ subroutine radiation(ncol, nlev, istartcol, iendcol, config, & ! extinction due to Rayleigh scattering), Planck functions and ! incoming shortwave flux at each g-point, for the specified ! range of atmospheric columns - if (config%i_gas_model_sw == IGasModelMonochromatic) then + if (config%i_gas_model == IGasModelMonochromatic) then call gas_optics_mono(ncol,nlev,istartcol,iendcol, config, & & single_level, thermodynamics, gas, lw_albedo, & & od_lw, od_sw, ssa_sw, & & planck_hl, lw_emission, incoming_sw) + else if (config%i_gas_model == IGasModelIFSRRTMG) then + call gas_optics_rrtmg(ncol,nlev,istartcol,iendcol, config, & + & single_level, thermodynamics, gas, & + & od_lw, od_sw, ssa_sw, lw_albedo=lw_albedo, & + & planck_hl=planck_hl, lw_emission=lw_emission, & + & incoming_sw=incoming_sw) else - if (config%i_gas_model_sw == IGasModelIFSRRTMG & - & .or. config%i_gas_model_lw == IGasModelIFSRRTMG) then - call gas_optics_rrtmg(ncol,nlev,istartcol,iendcol, config, & - & single_level, thermodynamics, gas, & - & od_lw, od_sw, ssa_sw, lw_albedo=lw_albedo, & - & planck_hl=planck_hl, lw_emission=lw_emission, & - & incoming_sw=incoming_sw) - end if - if (config%i_gas_model_sw == IGasModelECCKD & - & .or. config%i_gas_model_lw == IGasModelECCKD) then - call gas_optics_ecckd(ncol,nlev,istartcol,iendcol, config, & - & single_level, thermodynamics, gas, & - & od_lw, od_sw, ssa_sw, lw_albedo=lw_albedo, & - & planck_hl=planck_hl, lw_emission=lw_emission, & - & incoming_sw=incoming_sw) - end if + call gas_optics_ecckd(ncol,nlev,istartcol,iendcol, config, & + & single_level, thermodynamics, gas, & + & od_lw, od_sw, ssa_sw, lw_albedo=lw_albedo, & + & planck_hl=planck_hl, lw_emission=lw_emission, & + & incoming_sw=incoming_sw) end if if (config%do_clouds) then @@ -364,7 +349,7 @@ subroutine radiation(ncol, nlev, istartcol, iendcol, config, & ! Compute hydrometeor absorption/scattering properties in each ! shortwave and longwave band - if (config%i_gas_model_sw == IGasModelMonochromatic) then + if (config%i_gas_model == IGasModelMonochromatic) then call cloud_optics_mono(nlev, istartcol, iendcol, & & config, thermodynamics, cloud, & & od_lw_cloud, ssa_lw_cloud, g_lw_cloud, & @@ -383,7 +368,7 @@ subroutine radiation(ncol, nlev, istartcol, iendcol, config, & end if ! do_clouds if (config%use_aerosols) then - if (config%i_gas_model_sw == IGasModelMonochromatic) then + if (config%i_gas_model == IGasModelMonochromatic) then ! call add_aerosol_optics_mono(nlev,istartcol,iendcol, & ! & config, thermodynamics, gas, aerosol, & ! & od_lw, ssa_lw, g_lw, od_sw, ssa_sw, g_sw) diff --git a/radiation/radiation_liquid_optics_slingo.F90 b/radiation/radiation_liquid_optics_slingo.F90 index 4f8f8104..ac7836d5 100644 --- a/radiation/radiation_liquid_optics_slingo.F90 +++ b/radiation/radiation_liquid_optics_slingo.F90 @@ -1,5 +1,3 @@ -! radiation_liquid_optics_slingo.F90 - Slingo SW & Lindner-Li LW parameterization of liquid droplet optics -! ! (C) Copyright 2016- ECMWF. ! ! This software is licensed under the terms of the Apache Licence Version 2.0 @@ -8,6 +6,8 @@ ! In applying this licence, ECMWF does not waive the privileges and immunities ! granted to it by virtue of its status as an intergovernmental organisation ! nor does it submit to any jurisdiction. + +! radiation_liquid_optics_slingo.F90 - Slingo SW & Lindner-Li LW parameterization of liquid droplet optics ! ! Author: Robin Hogan ! Email: r.j.hogan@ecmwf.int diff --git a/radiation/radiation_mcica_lw.F90 b/radiation/radiation_mcica_lw.F90 index f6bfcf98..53533b93 100644 --- a/radiation/radiation_mcica_lw.F90 +++ b/radiation/radiation_mcica_lw.F90 @@ -17,8 +17,7 @@ ! 2017-04-22 R. Hogan Store surface fluxes at all g-points ! 2017-07-12 R. Hogan Call fast adding method if only clouds scatter ! 2017-10-23 R. Hogan Renamed single-character variables - -#include "ecrad_config.h" +! 2025-08-06 R. El Khatib Optimization module radiation_mcica_lw @@ -123,16 +122,11 @@ subroutine solver_mcica_lw(nlev,istartcol,iendcol, & ! Total cloud cover output from the cloud generator real(jprb) :: total_cloud_cover + real(jprb) :: reverse_decorrelation_scaling + ! Identify clear-sky layers logical :: is_clear_sky_layer(nlev) - ! Temporary storage for more efficient summation -#ifdef DWD_REDUCTION_OPTIMIZATIONS - real(jprb), dimension(nlev+1,2) :: sum_aux -#else - real(jprb) :: sum_up, sum_dn -#endif - ! Index of the highest cloudy layer integer :: i_cloud_top @@ -153,6 +147,8 @@ subroutine solver_mcica_lw(nlev,istartcol,iendcol, & ng = config%n_g_lw + reverse_decorrelation_scaling=1._jprb/config%cloud_inhom_decorr_scaling + ! Loop through columns do jcol = istartcol,iendcol @@ -162,7 +158,7 @@ subroutine solver_mcica_lw(nlev,istartcol,iendcol, & ! transmittance etc at each model level call calc_ref_trans_lw(ng*nlev, & & od(:,:,jcol), ssa(:,:,jcol), g(:,:,jcol), & - & planck_hl(:,1:nlev,jcol), planck_hl(:,2:nlev+1,jcol), & + & planck_hl(:,1:jlev,jcol), planck_hl(:,2:jlev+1,jcol), & & ref_clear, trans_clear, & & source_up_clear, source_dn_clear) ! Then use adding method to compute fluxes @@ -187,30 +183,8 @@ subroutine solver_mcica_lw(nlev,istartcol,iendcol, & end if ! Sum over g-points to compute broadband fluxes -#ifdef DWD_REDUCTION_OPTIMIZATIONS - sum_aux(:,:) = 0.0_jprb - do jg = 1,ng - do jlev = 1,nlev+1 - sum_aux(jlev,1) = sum_aux(jlev,1) + flux_up_clear(jg,jlev) - sum_aux(jlev,2) = sum_aux(jlev,2) + flux_dn_clear(jg,jlev) - end do - end do - flux%lw_up_clear(jcol,:) = sum_aux(:,1) - flux%lw_dn_clear(jcol,:) = sum_aux(:,2) -#else - do jlev = 1,nlev+1 - sum_up = 0.0_jprb - sum_dn = 0.0_jprb - !$omp simd reduction(+:sum_up, sum_dn) - do jg = 1,ng - sum_up = sum_up + flux_up_clear(jg,jlev) - sum_dn = sum_dn + flux_dn_clear(jg,jlev) - end do - flux%lw_up_clear(jcol,jlev) = sum_up - flux%lw_dn_clear(jcol,jlev) = sum_dn - end do -#endif - + flux%lw_up_clear(jcol,:) = sum(flux_up_clear,1) + flux%lw_dn_clear(jcol,:) = sum(flux_dn_clear,1) ! Store surface spectral downwelling fluxes flux%lw_dn_surf_clear_g(:,jcol) = flux_dn_clear(:,nlev+1) @@ -220,7 +194,7 @@ subroutine solver_mcica_lw(nlev,istartcol,iendcol, & & single_level%iseed(jcol) + 997, & & config%cloud_fraction_threshold, & & cloud%fraction(jcol,:), cloud%overlap_param(jcol,:), & - & config%cloud_inhom_decorr_scaling, cloud%fractional_std(jcol,:), & + & reverse_decorrelation_scaling, cloud%fractional_std(jcol,:), & & config%pdf_sampler, od_scaling, total_cloud_cover, & & use_beta_overlap=config%use_beta_overlap, & & use_vectorizable_generator=config%use_vectorizable_generator) @@ -309,12 +283,10 @@ subroutine solver_mcica_lw(nlev,istartcol,iendcol, & else ! Clear-sky layer: copy over clear-sky values - do jg = 1,ng - reflectance(jg,jlev) = ref_clear(jg,jlev) - transmittance(jg,jlev) = trans_clear(jg,jlev) - source_up(jg,jlev) = source_up_clear(jg,jlev) - source_dn(jg,jlev) = source_dn_clear(jg,jlev) - end do + reflectance(:,jlev) = ref_clear(:,jlev) + transmittance(:,jlev) = trans_clear(:,jlev) + source_up(:,jlev) = source_up_clear(:,jlev) + source_dn(:,jlev) = source_dn_clear(:,jlev) end if end do @@ -339,38 +311,15 @@ subroutine solver_mcica_lw(nlev,istartcol,iendcol, & end if ! Store overcast broadband fluxes -#ifdef DWD_REDUCTION_OPTIMIZATIONS - sum_aux(:,:) = 0._jprb - do jg = 1, ng - do jlev = 1, nlev+1 - sum_aux(jlev,1) = sum_aux(jlev,1) + flux_up(jg,jlev) - sum_aux(jlev,2) = sum_aux(jlev,2) + flux_dn(jg,jlev) - end do - end do - flux%lw_up(jcol,:) = sum_aux(:,1) - flux%lw_dn(jcol,:) = sum_aux(:,2) -#else - do jlev = 1,nlev+1 - sum_up = 0.0_jprb - sum_dn = 0.0_jprb - !$omp simd reduction(+:sum_up, sum_dn) - do jg = 1,ng - sum_up = sum_up + flux_up(jg,jlev) - sum_dn = sum_dn + flux_dn(jg,jlev) - end do - flux%lw_up(jcol,jlev) = sum_up - flux%lw_dn(jcol,jlev) = sum_dn - end do -#endif + flux%lw_up(jcol,:) = sum(flux_up,1) + flux%lw_dn(jcol,:) = sum(flux_dn,1) ! Cloudy flux profiles currently assume completely overcast ! skies; perform weighted average with clear-sky profile - do jlev = 1,nlev+1 - flux%lw_up(jcol,jlev) = total_cloud_cover *flux%lw_up(jcol,jlev) & - & + (1.0_jprb - total_cloud_cover)*flux%lw_up_clear(jcol,jlev) - flux%lw_dn(jcol,jlev) = total_cloud_cover *flux%lw_dn(jcol,jlev) & - & + (1.0_jprb - total_cloud_cover)*flux%lw_dn_clear(jcol,jlev) - end do + flux%lw_up(jcol,:) = total_cloud_cover *flux%lw_up(jcol,:) & + & + (1.0_jprb - total_cloud_cover)*flux%lw_up_clear(jcol,:) + flux%lw_dn(jcol,:) = total_cloud_cover *flux%lw_dn(jcol,:) & + & + (1.0_jprb - total_cloud_cover)*flux%lw_dn_clear(jcol,:) ! Store surface spectral downwelling fluxes flux%lw_dn_surf_g(:,jcol) = total_cloud_cover*flux_dn(:,nlev+1) & & + (1.0_jprb - total_cloud_cover)*flux%lw_dn_surf_clear_g(:,jcol) @@ -390,10 +339,8 @@ subroutine solver_mcica_lw(nlev,istartcol,iendcol, & else ! No cloud in profile and clear-sky fluxes already ! calculated: copy them over - do jlev = 1,nlev+1 - flux%lw_up(jcol,jlev) = flux%lw_up_clear(jcol,jlev) - flux%lw_dn(jcol,jlev) = flux%lw_dn_clear(jcol,jlev) - end do + flux%lw_up(jcol,:) = flux%lw_up_clear(jcol,:) + flux%lw_dn(jcol,:) = flux%lw_dn_clear(jcol,:) flux%lw_dn_surf_g(:,jcol) = flux%lw_dn_surf_clear_g(:,jcol) if (config%do_lw_derivatives) then call calc_lw_derivatives_ica(ng, nlev, jcol, trans_clear, flux_up_clear(:,nlev+1), & diff --git a/radiation/radiation_mcica_sw.F90 b/radiation/radiation_mcica_sw.F90 index 38b58290..a2b3e062 100644 --- a/radiation/radiation_mcica_sw.F90 +++ b/radiation/radiation_mcica_sw.F90 @@ -16,8 +16,7 @@ ! 2017-04-11 R. Hogan Receive albedos at g-points ! 2017-04-22 R. Hogan Store surface fluxes at all g-points ! 2017-10-23 R. Hogan Renamed single-character variables - -#include "ecrad_config.h" +! 2025-08-06 R. El Khatib Optimization module radiation_mcica_sw @@ -121,12 +120,7 @@ subroutine solver_mcica_sw(nlev,istartcol,iendcol, & ! Total cloud cover output from the cloud generator real(jprb) :: total_cloud_cover - ! Temporary storage for more efficient summation -#ifdef DWD_REDUCTION_OPTIMIZATIONS - real(jprb), dimension(nlev+1,3) :: sum_aux -#else - real(jprb) :: sum_up, sum_dn_diff, sum_dn_dir -#endif + real(jprb) :: reverse_decorrelation_scaling ! Number of g points integer :: ng @@ -145,6 +139,8 @@ subroutine solver_mcica_sw(nlev,istartcol,iendcol, & ng = config%n_g_sw + reverse_decorrelation_scaling=1._jprb/config%cloud_inhom_decorr_scaling + ! Loop through columns do jcol = istartcol,iendcol ! Only perform calculation if sun above the horizon @@ -183,56 +179,27 @@ subroutine solver_mcica_sw(nlev,istartcol,iendcol, & & trans_dir_dir_clear, flux_up, flux_dn_diffuse, flux_dn_direct) ! Sum over g-points to compute and save clear-sky broadband - ! fluxes. Note that the built-in "sum" function is very slow, - ! and before being replaced by the alternatives below - ! accounted for around 40% of the total cost of this routine. -#ifdef DWD_REDUCTION_OPTIMIZATIONS - ! Optimized summation for the NEC architecture - sum_aux(:,:) = 0.0_jprb - do jg = 1,ng - do jlev = 1,nlev+1 - sum_aux(jlev,1) = sum_aux(jlev,1) + flux_up(jg,jlev) - sum_aux(jlev,2) = sum_aux(jlev,2) + flux_dn_direct(jg,jlev) - sum_aux(jlev,3) = sum_aux(jlev,3) + flux_dn_diffuse(jg,jlev) - end do - end do - flux%sw_up_clear(jcol,:) = sum_aux(:,1) - flux%sw_dn_clear(jcol,:) = sum_aux(:,2) + sum_aux(:,3) + ! fluxes + flux%sw_up_clear(jcol,:) = sum(flux_up,1) if (allocated(flux%sw_dn_direct_clear)) then - flux%sw_dn_direct_clear(jcol,:) = sum_aux(:,2) + flux%sw_dn_direct_clear(jcol,:) & + & = sum(flux_dn_direct,1) + flux%sw_dn_clear(jcol,:) = sum(flux_dn_diffuse,1) & + & + flux%sw_dn_direct_clear(jcol,:) + else + flux%sw_dn_clear(jcol,:) = sum(flux_dn_diffuse,1) & + & + sum(flux_dn_direct,1) end if -#else - ! Optimized summation for the x86-64 architecture - do jlev = 1,nlev+1 - sum_up = 0.0_jprb - sum_dn_diff = 0.0_jprb - sum_dn_dir = 0.0_jprb - !$omp simd reduction(+:sum_up, sum_dn_diff, sum_dn_dir) - do jg = 1,ng - sum_up = sum_up + flux_up(jg,jlev) - sum_dn_diff = sum_dn_diff + flux_dn_diffuse(jg,jlev) - sum_dn_dir = sum_dn_dir + flux_dn_direct(jg,jlev) - end do - flux%sw_up_clear(jcol,jlev) = sum_up - flux%sw_dn_clear(jcol,jlev) = sum_dn_diff + sum_dn_dir - if (allocated(flux%sw_dn_direct_clear)) then - flux%sw_dn_direct_clear(jcol,jlev) = sum_dn_dir - end if - end do -#endif - ! Store spectral downwelling fluxes at surface - do jg = 1,ng - flux%sw_dn_diffuse_surf_clear_g(jg,jcol) = flux_dn_diffuse(jg,nlev+1) - flux%sw_dn_direct_surf_clear_g(jg,jcol) = flux_dn_direct(jg,nlev+1) - end do + flux%sw_dn_diffuse_surf_clear_g(:,jcol) = flux_dn_diffuse(:,nlev+1) + flux%sw_dn_direct_surf_clear_g(:,jcol) = flux_dn_direct(:,nlev+1) ! Do cloudy-sky calculation call cloud_generator(ng, nlev, config%i_overlap_scheme, & & single_level%iseed(jcol), & & config%cloud_fraction_threshold, & & cloud%fraction(jcol,:), cloud%overlap_param(jcol,:), & - & config%cloud_inhom_decorr_scaling, cloud%fractional_std(jcol,:), & + & reverse_decorrelation_scaling, cloud%fractional_std(jcol,:), & & config%pdf_sampler, od_scaling, total_cloud_cover, & & use_beta_overlap=config%use_beta_overlap, & & use_vectorizable_generator=config%use_vectorizable_generator) @@ -286,13 +253,11 @@ subroutine solver_mcica_sw(nlev,istartcol,iendcol, & else ! Clear-sky layer: copy over clear-sky values - do jg = 1,ng - reflectance(jg,jlev) = ref_clear(jg,jlev) - transmittance(jg,jlev) = trans_clear(jg,jlev) - ref_dir(jg,jlev) = ref_dir_clear(jg,jlev) - trans_dir_diff(jg,jlev) = trans_dir_diff_clear(jg,jlev) - trans_dir_dir(jg,jlev) = trans_dir_dir_clear(jg,jlev) - end do + reflectance(:,jlev) = ref_clear(:,jlev) + transmittance(:,jlev) = trans_clear(:,jlev) + ref_dir(:,jlev) = ref_dir_clear(:,jlev) + trans_dir_diff(:,jlev) = trans_dir_diff_clear(:,jlev) + trans_dir_dir(:,jlev) = trans_dir_dir_clear(:,jlev) end if end do @@ -303,98 +268,63 @@ subroutine solver_mcica_sw(nlev,istartcol,iendcol, & & trans_dir_dir, flux_up, flux_dn_diffuse, flux_dn_direct) ! Store overcast broadband fluxes -#ifdef DWD_REDUCTION_OPTIMIZATIONS - sum_aux(:,:) = 0.0_jprb - do jg = 1,ng - do jlev = 1,nlev+1 - sum_aux(jlev,1) = sum_aux(jlev,1) + flux_up(jg,jlev) - sum_aux(jlev,2) = sum_aux(jlev,2) + flux_dn_direct(jg,jlev) - sum_aux(jlev,3) = sum_aux(jlev,3) + flux_dn_diffuse(jg,jlev) - end do - end do - flux%sw_up(jcol,:) = sum_aux(:,1) - flux%sw_dn(jcol,:) = sum_aux(:,2) + sum_aux(:,3) + flux%sw_up(jcol,:) = sum(flux_up,1) if (allocated(flux%sw_dn_direct)) then - flux%sw_dn_direct(jcol,:) = sum_aux(:,2) + flux%sw_dn_direct(jcol,:) = sum(flux_dn_direct,1) + flux%sw_dn(jcol,:) = sum(flux_dn_diffuse,1) & + & + flux%sw_dn_direct(jcol,:) + else + flux%sw_dn(jcol,:) = sum(flux_dn_diffuse,1) & + & + sum(flux_dn_direct,1) end if -#else - do jlev = 1,nlev+1 - sum_up = 0.0_jprb - sum_dn_diff = 0.0_jprb - sum_dn_dir = 0.0_jprb - !$omp simd reduction(+:sum_up, sum_dn_diff, sum_dn_dir) - do jg = 1,ng - sum_up = sum_up + flux_up(jg,jlev) - sum_dn_diff = sum_dn_diff + flux_dn_diffuse(jg,jlev) - sum_dn_dir = sum_dn_dir + flux_dn_direct(jg,jlev) - end do - flux%sw_up(jcol,jlev) = sum_up - flux%sw_dn(jcol,jlev) = sum_dn_diff + sum_dn_dir - if (allocated(flux%sw_dn_direct)) then - flux%sw_dn_direct(jcol,jlev) = sum_dn_dir - end if - end do -#endif - + ! Cloudy flux profiles currently assume completely overcast ! skies; perform weighted average with clear-sky profile - do jlev = 1, nlev+1 - flux%sw_up(jcol,jlev) = total_cloud_cover *flux%sw_up(jcol,jlev) & - & + (1.0_jprb - total_cloud_cover)*flux%sw_up_clear(jcol,jlev) - flux%sw_dn(jcol,jlev) = total_cloud_cover *flux%sw_dn(jcol,jlev) & - & + (1.0_jprb - total_cloud_cover)*flux%sw_dn_clear(jcol,jlev) - if (allocated(flux%sw_dn_direct)) then - flux%sw_dn_direct(jcol,jlev) = total_cloud_cover *flux%sw_dn_direct(jcol,jlev) & - & + (1.0_jprb - total_cloud_cover)*flux%sw_dn_direct_clear(jcol,jlev) - end if - end do + flux%sw_up(jcol,:) = total_cloud_cover *flux%sw_up(jcol,:) & + & + (1.0_jprb - total_cloud_cover)*flux%sw_up_clear(jcol,:) + flux%sw_dn(jcol,:) = total_cloud_cover *flux%sw_dn(jcol,:) & + & + (1.0_jprb - total_cloud_cover)*flux%sw_dn_clear(jcol,:) + if (allocated(flux%sw_dn_direct)) then + flux%sw_dn_direct(jcol,:) = total_cloud_cover *flux%sw_dn_direct(jcol,:) & + & + (1.0_jprb - total_cloud_cover)*flux%sw_dn_direct_clear(jcol,:) + end if ! Likewise for surface spectral fluxes - do jg = 1,ng - flux%sw_dn_diffuse_surf_g(jg,jcol) = flux_dn_diffuse(jg,nlev+1) - flux%sw_dn_direct_surf_g(jg,jcol) = flux_dn_direct(jg,nlev+1) - flux%sw_dn_diffuse_surf_g(jg,jcol) = total_cloud_cover *flux%sw_dn_diffuse_surf_g(jg,jcol) & - & + (1.0_jprb - total_cloud_cover)*flux%sw_dn_diffuse_surf_clear_g(jg,jcol) - flux%sw_dn_direct_surf_g(jg,jcol) = total_cloud_cover *flux%sw_dn_direct_surf_g(jg,jcol) & - & + (1.0_jprb - total_cloud_cover)*flux%sw_dn_direct_surf_clear_g(jg,jcol) - end do - + flux%sw_dn_diffuse_surf_g(:,jcol) = flux_dn_diffuse(:,nlev+1) + flux%sw_dn_direct_surf_g(:,jcol) = flux_dn_direct(:,nlev+1) + flux%sw_dn_diffuse_surf_g(:,jcol) = total_cloud_cover *flux%sw_dn_diffuse_surf_g(:,jcol) & + & + (1.0_jprb - total_cloud_cover)*flux%sw_dn_diffuse_surf_clear_g(:,jcol) + flux%sw_dn_direct_surf_g(:,jcol) = total_cloud_cover *flux%sw_dn_direct_surf_g(:,jcol) & + & + (1.0_jprb - total_cloud_cover)*flux%sw_dn_direct_surf_clear_g(:,jcol) + else ! No cloud in profile and clear-sky fluxes already ! calculated: copy them over - do jlev = 1, nlev+1 - flux%sw_up(jcol,jlev) = flux%sw_up_clear(jcol,jlev) - flux%sw_dn(jcol,jlev) = flux%sw_dn_clear(jcol,jlev) - if (allocated(flux%sw_dn_direct)) then - flux%sw_dn_direct(jcol,jlev) = flux%sw_dn_direct_clear(jcol,jlev) - end if - end do - do jg = 1,ng - flux%sw_dn_diffuse_surf_g(jg,jcol) = flux%sw_dn_diffuse_surf_clear_g(jg,jcol) - flux%sw_dn_direct_surf_g(jg,jcol) = flux%sw_dn_direct_surf_clear_g(jg,jcol) - end do + flux%sw_up(jcol,:) = flux%sw_up_clear(jcol,:) + flux%sw_dn(jcol,:) = flux%sw_dn_clear(jcol,:) + if (allocated(flux%sw_dn_direct)) then + flux%sw_dn_direct(jcol,:) = flux%sw_dn_direct_clear(jcol,:) + end if + flux%sw_dn_diffuse_surf_g(:,jcol) = flux%sw_dn_diffuse_surf_clear_g(:,jcol) + flux%sw_dn_direct_surf_g(:,jcol) = flux%sw_dn_direct_surf_clear_g(:,jcol) end if ! Cloud is present in profile else ! Set fluxes to zero if sun is below the horizon - do jlev = 1, nlev+1 - flux%sw_up(jcol,jlev) = 0.0_jprb - flux%sw_dn(jcol,jlev) = 0.0_jprb - if (allocated(flux%sw_dn_direct)) then - flux%sw_dn_direct(jcol,jlev) = 0.0_jprb - end if - flux%sw_up_clear(jcol,jlev) = 0.0_jprb - flux%sw_dn_clear(jcol,jlev) = 0.0_jprb - if (allocated(flux%sw_dn_direct_clear)) then - flux%sw_dn_direct_clear(jcol,jlev) = 0.0_jprb - end if - end do - do jg = 1,ng - flux%sw_dn_diffuse_surf_g(jg,jcol) = 0.0_jprb - flux%sw_dn_direct_surf_g(jg,jcol) = 0.0_jprb - flux%sw_dn_diffuse_surf_clear_g(jg,jcol) = 0.0_jprb - flux%sw_dn_direct_surf_clear_g(jg,jcol) = 0.0_jprb - end do + flux%sw_up(jcol,:) = 0.0_jprb + flux%sw_dn(jcol,:) = 0.0_jprb + if (allocated(flux%sw_dn_direct)) then + flux%sw_dn_direct(jcol,:) = 0.0_jprb + end if + flux%sw_up_clear(jcol,:) = 0.0_jprb + flux%sw_dn_clear(jcol,:) = 0.0_jprb + if (allocated(flux%sw_dn_direct_clear)) then + flux%sw_dn_direct_clear(jcol,:) = 0.0_jprb + end if + flux%sw_dn_diffuse_surf_g(:,jcol) = 0.0_jprb + flux%sw_dn_direct_surf_g(:,jcol) = 0.0_jprb + flux%sw_dn_diffuse_surf_clear_g(:,jcol) = 0.0_jprb + flux%sw_dn_direct_surf_clear_g(:,jcol) = 0.0_jprb end if ! Sun above horizon end do ! Loop over columns diff --git a/radiation/radiation_pdf_sampler.F90 b/radiation/radiation_pdf_sampler.F90 index e901646f..1e3b799e 100644 --- a/radiation/radiation_pdf_sampler.F90 +++ b/radiation/radiation_pdf_sampler.F90 @@ -1,5 +1,3 @@ -! radiation_pdf_sampler.F90 - Get samples from a PDF for McICA -! ! (C) Copyright 2015- ECMWF. ! ! This software is licensed under the terms of the Apache Licence Version 2.0 @@ -8,6 +6,8 @@ ! In applying this licence, ECMWF does not waive the privileges and immunities ! granted to it by virtue of its status as an intergovernmental organisation ! nor does it submit to any jurisdiction. + +! radiation_pdf_sampler.F90 - Get samples from a PDF for McICA ! ! Author: Robin Hogan ! Email: r.j.hogan@ecmwf.int @@ -52,9 +52,9 @@ module radiation_pdf_sampler contains !--------------------------------------------------------------------- - ! Load look-up table from a file + ! Load look-up table from a file subroutine setup_pdf_sampler(this, file_name, iverbose) - + use yomhook, only : lhook, dr_hook, jphook use easy_netcdf, only : netcdf_file @@ -114,7 +114,7 @@ subroutine deallocate_pdf_sampler(this) end if if (lhook) call dr_hook('radiation_pdf_sampler:deallocate',1,hook_handle) - + end subroutine deallocate_pdf_sampler @@ -124,7 +124,7 @@ end subroutine deallocate_pdf_sampler ! "cdf", and return it in val. Since this is an elemental ! subroutine, fsd, cdf and val may be arrays. elemental subroutine sample_from_pdf(this, fsd, cdf, val) - + class(pdf_sampler_type), intent(in) :: this ! Fractional standard deviation (0 to 4) and cumulative @@ -163,7 +163,7 @@ end subroutine sample_from_pdf ! cumulative distribution function values "cdf", and return in ! val. For false elements of mask, return zero in val. subroutine sample_from_pdf_masked(this, nsamp, fsd, cdf, val, mask) - + class(pdf_sampler_type), intent(in) :: this ! Number of samples @@ -194,11 +194,11 @@ subroutine sample_from_pdf_masked(this, nsamp, fsd, cdf, val, mask) wcdf = cdf(jsamp) * (this%ncdf-1) + 1.0_jprb icdf = max(1, min(int(wcdf), this%ncdf-1)) wcdf = max(0.0_jprb, min(wcdf - icdf, 1.0_jprb)) - + wfsd = (fsd(jsamp)-this%fsd1) * this%inv_fsd_interval + 1.0_jprb ifsd = max(1, min(int(wfsd), this%nfsd-1)) wfsd = max(0.0_jprb, min(wfsd - ifsd, 1.0_jprb)) - + val(jsamp)=(1.0_jprb-wcdf)*(1.0_jprb-wfsd) * this%val(icdf ,ifsd) & & +(1.0_jprb-wcdf)* wfsd * this%val(icdf ,ifsd+1) & & + wcdf *(1.0_jprb-wfsd) * this%val(icdf+1,ifsd) & diff --git a/radiation/radiation_save.F90 b/radiation/radiation_save.F90 index 678b6882..e8d5e5e1 100644 --- a/radiation/radiation_save.F90 +++ b/radiation/radiation_save.F90 @@ -80,12 +80,12 @@ subroutine save_fluxes(file_name, config, thermodynamics, flux, & else if (i_local_verbose >= 1) then write(nulout,'(a,a,a)') 'Warning: neither longwave nor shortwave computed so ', & - & trim(file_name),' not written' + & file_name,' not written' end if return end if - if (config%i_gas_model_lw == IGasModelMonochromatic & + if (config%i_gas_model == IGasModelMonochromatic & .and. config%mono_lw_wavelength > 0.0_jprb) then lw_units_str = 'W m-3' else @@ -514,7 +514,7 @@ subroutine save_net_fluxes(file_name, config, thermodynamics, flux, & return end if - if (config%i_gas_model_lw == IGasModelMonochromatic & + if (config%i_gas_model == IGasModelMonochromatic & .and. config%mono_lw_wavelength > 0.0_jprb) then lw_units_str = 'W m-3' else @@ -777,9 +777,7 @@ subroutine save_radiative_properties(file_name, nlev, & ! Emission (Planck*emissivity) and albedo (1-emissivity) at the ! surface at each longwave g-point - real(jprb), intent(in), dimension(config%n_g_lw, istartcol:iendcol) :: lw_emission, lw_albedo - - ! Local variables + real(jprb), dimension(config%n_g_lw, istartcol:iendcol) :: lw_emission, lw_albedo integer :: n_col_local ! Number of columns from istartcol to iendcol diff --git a/radiation/radiation_spectral_definition.F90 b/radiation/radiation_spectral_definition.F90 index 8229cc4c..fd6b27e5 100644 --- a/radiation/radiation_spectral_definition.F90 +++ b/radiation/radiation_spectral_definition.F90 @@ -14,8 +14,6 @@ ! License: see the COPYING file for details ! -#include "ecrad_config.h" - module radiation_spectral_definition use parkind1, only : jprb @@ -24,7 +22,7 @@ module radiation_spectral_definition public - real(jprb), parameter :: SolarReferenceTemperature = 5777.0_jprb ! K + real(jprb), parameter :: SolarReferenceTemperature = 5777.0_jprb ! K real(jprb), parameter :: TerrestrialReferenceTemperature = 273.15_jprb ! K !--------------------------------------------------------------------- @@ -76,7 +74,6 @@ module radiation_spectral_definition procedure :: calc_mapping_from_wavenumber_bands procedure :: print_mapping_from_bands procedure :: min_wavenumber, max_wavenumber - procedure :: weighted_mapping end type spectral_definition_type @@ -87,11 +84,7 @@ module radiation_spectral_definition ! file of the type used to describe an ecCKD model subroutine read_spectral_definition(this, file) -#ifdef EASY_NETCDF_READ_MPI use easy_netcdf_read_mpi, only : netcdf_file -#else - use easy_netcdf, only : netcdf_file -#endif use yomhook, only : lhook, dr_hook, jphook class(spectral_definition_type), intent(inout) :: this @@ -138,15 +131,14 @@ end subroutine read_spectral_definition !--------------------------------------------------------------------- - ! Store a simple band description by copying over the reference - ! temperature and the lower and upper wavenumbers of each band - subroutine allocate_bands_only(this, reference_temperature, wavenumber1, wavenumber2) + ! Store a simple band description by copying over the lower and + ! upper wavenumbers of each band + subroutine allocate_bands_only(this, wavenumber1, wavenumber2) use yomhook, only : lhook, dr_hook, jphook class(spectral_definition_type), intent(inout) :: this - real(jprb), intent(in) :: reference_temperature ! K - real(jprb), dimension(:), intent(in) :: wavenumber1, wavenumber2 ! cm-1 + real(jprb), dimension(:), intent(in) :: wavenumber1, wavenumber2 real(jphook) :: hook_handle @@ -159,8 +151,7 @@ subroutine allocate_bands_only(this, reference_temperature, wavenumber1, wavenum allocate(this%wavenumber2_band(this%nband)) this%wavenumber1_band = wavenumber1 this%wavenumber2_band = wavenumber2 - this%reference_temperature = reference_temperature - + if (lhook) call dr_hook('radiation_spectral_definition:allocate_bands_only',1,hook_handle) end subroutine allocate_bands_only @@ -175,7 +166,6 @@ subroutine deallocate(this) this%nwav = 0 this%ng = 0 this%nband = 0 - this%reference_temperature = -1.0_jprb if (allocated(this%wavenumber1)) deallocate(this%wavenumber1) if (allocated(this%wavenumber2)) deallocate(this%wavenumber2) @@ -843,97 +833,6 @@ subroutine calc_mapping_from_wavenumber_bands(this, & end subroutine calc_mapping_from_wavenumber_bands - - !--------------------------------------------------------------------- - ! Used for computing UV index / UV biologically effective dose: - ! provides the weights that should be applied to each g-point for a - ! summation. The user provides monotonically increasing wavelengths - ! and associated weights that are assumed to vary logarithmically - ! between wavelengths. - function weighted_mapping(this, wavelength, weights_in, do_logarithmic) - - use radiation_io, only : nulerr, radiation_abort - - class(spectral_definition_type), intent(in) :: this - real(jprb), intent(in) :: wavelength(:) ! m - real(jprb), intent(in) :: weights_in(:) - logical, intent(in), optional :: do_logarithmic - - real(jprb) :: weighted_mapping(this%ng) - - ! Weights in wavenumber space - real(jprb) :: weights_wn(this%nwav) - - ! Wavelength (m) corresponding to a wavenumber - real(jprb) :: wavelength_wn - - ! Weight (might be natural logarithms) - real(jprb) :: weight1, weight2 - - ! Number of input wavelengths - integer :: nwl - - ! Wavelength loop index - integer :: jwl - - ! Index of current wavenumber - integer :: iwn - - logical :: do_logarithmic_local - - if (present(do_logarithmic)) then - do_logarithmic_local = do_logarithmic - else - do_logarithmic_local = .false. - end if - - nwl = size(wavelength) - - if (allocated(this%gpoint_fraction)) then - - weights_wn(:) = 0.0_jprb - iwn = this%nwav - ! Find first wavenumber in range - wavelength_wn = 0.01_jprb / (0.5_jprb * (this%wavenumber1(iwn)+this%wavenumber2(iwn))) - do while(wavelength(1) > wavelength_wn .and. iwn > 1) - iwn = iwn-1 - wavelength_wn = 0.01_jprb / (0.5_jprb * (this%wavenumber1(iwn)+this%wavenumber2(iwn))) - end do - ! Loop over user-supplied wavelength intervals - do jwl = 1,nwl-1 - if (do_logarithmic_local) then - weight1 = log(weights_in(jwl)) - weight2 = log(weights_in(jwl+1)) - else - weight1 = weights_in(jwl); - weight2 = weights_in(jwl); - end if - do while (wavelength(jwl+1) > wavelength_wn) - weights_wn(iwn) = (weight1*(wavelength(jwl+1)-wavelength_wn) & - & +weight2*(wavelength_wn-wavelength(jwl))) & - & /(wavelength(jwl+1)-wavelength(jwl)) - if (do_logarithmic_local) then - weights_wn(iwn) = exp(weights_wn(iwn)) - end if - if (iwn > 1) then - iwn = iwn-1 - wavelength_wn = 0.01_jprb / (0.5_jprb * (this%wavenumber1(iwn)+this%wavenumber2(iwn))) - else - exit - end if - end do - end do - - weighted_mapping = matmul(weights_wn, this%gpoint_fraction) - - else - - write(nulerr,'(a)') '*** Error: requested weighted mapping per g-point but only available per band' - call radiation_abort('Radiation configuration error') - - end if - - end function weighted_mapping !--------------------------------------------------------------------- ! Print out the mapping computed by calc_mapping_from_bands diff --git a/radiation/radiation_thermodynamics.F90 b/radiation/radiation_thermodynamics.F90 index 7ba7503a..6e31e229 100644 --- a/radiation/radiation_thermodynamics.F90 +++ b/radiation/radiation_thermodynamics.F90 @@ -76,10 +76,10 @@ subroutine allocate_thermodynamics_arrays(this, ncol, nlev, & if (present(use_h2o_sat)) then use_h2o_sat_local = use_h2o_sat end if - + if (use_h2o_sat_local) then allocate(this%h2o_sat_liq(ncol,nlev)) - end if + end if if (lhook) call dr_hook('radiation_thermodynamics:allocate',1,hook_handle) @@ -109,7 +109,7 @@ subroutine deallocate_thermodynamics_arrays(this) end if if (lhook) call dr_hook('radiation_thermodynamics:deallocate',1,hook_handle) - + end subroutine deallocate_thermodynamics_arrays @@ -168,7 +168,7 @@ subroutine get_layer_mass(this,istartcol,iendcol,layer_mass) class(thermodynamics_type), intent(in) :: this integer, intent(in) :: istartcol, iendcol - real(jprb), intent(out) :: layer_mass(istartcol:iendcol,ubound(this%pressure_hl,2)) + real(jprb), intent(out) :: layer_mass(:,:) integer :: nlev real(jprb) :: inv_g @@ -183,8 +183,8 @@ subroutine get_layer_mass(this,istartcol,iendcol,layer_mass) layer_mass(istartcol:iendcol,1:nlev) & & = ( this%pressure_hl(istartcol:iendcol,2:nlev+1) & & -this%pressure_hl(istartcol:iendcol,1:nlev ) ) & - & * inv_g - + & * inv_g + if (lhook) call dr_hook('radiation_thermodynamics:get_layer_mass',1,hook_handle) end subroutine get_layer_mass @@ -214,7 +214,7 @@ subroutine get_layer_mass_column(this, icol, layer_mass) layer_mass = ( this%pressure_hl(icol,2:nlev+1) & & -this%pressure_hl(icol,1:nlev ) ) & & * inv_g - + if (lhook) call dr_hook('radiation_thermodynamics:get_layer_mass_column',1,hook_handle) end subroutine get_layer_mass_column @@ -260,7 +260,7 @@ subroutine get_layer_separation(pressure_hl, temperature_hl, layer_separation) ! don't take the logarithm of the first pressure in each column. layer_separation(i1:i2,1) = R_over_g * temperature_hl(i1:i2,2) & & * log(pressure_hl(i1:i2,3)/pressure_hl(i1:i2,2)) - + ! For other layers we take the separation between midpoints to ! be half the separation between the half-levels at the edge of ! the two adjacent layers @@ -285,7 +285,7 @@ subroutine get_layer_separation(pressure_hl, temperature_hl, layer_separation) end if - if (lhook) call dr_hook('radiation_thermodynamics:get_layer_separation',1,hook_handle) + if (lhook) call dr_hook('radiation_thermodynamics:get_layer_separation',1,hook_handle) end subroutine get_layer_separation @@ -326,5 +326,5 @@ function out_of_physical_bounds(this, istartcol, iendcol, do_fix) result(is_bad) if (lhook) call dr_hook('radiation_thermodynamics:out_of_physical_bounds',1,hook_handle) end function out_of_physical_bounds - + end module radiation_thermodynamics diff --git a/radiation/radiation_tripleclouds_lw.F90 b/radiation/radiation_tripleclouds_lw.F90 index e7c0f26a..47c0aa69 100644 --- a/radiation/radiation_tripleclouds_lw.F90 +++ b/radiation/radiation_tripleclouds_lw.F90 @@ -169,9 +169,6 @@ subroutine solver_tripleclouds_lw(nlev,istartcol,iendcol, & ! and below the ground, both treated as single-region clear skies logical :: is_clear_sky_layer(0:nlev+1) - ! Temporaries to speed up summations - real(jprb) :: sum_dn, sum_up - ! Index of the highest cloudy layer integer :: i_cloud_top @@ -251,7 +248,7 @@ subroutine solver_tripleclouds_lw(nlev,istartcol,iendcol, & ! Scattering in clear-sky flux calculation call calc_ref_trans_lw(ng*nlev, & & od(:,:,jcol), ssa(:,:,jcol), g(:,:,jcol), & - & planck_hl(:,1:nlev,jcol), planck_hl(:,2:nlev+1,jcol), & + & planck_hl(:,1:jlev,jcol), planck_hl(:,2:jlev+1,jcol), & & ref_clear, trans_clear, & & source_up_clear, source_dn_clear) ! Use adding method to compute fluxes @@ -263,23 +260,11 @@ subroutine solver_tripleclouds_lw(nlev,istartcol,iendcol, & if (config%do_clear) then ! Sum over g-points to compute broadband fluxes - do jlev = 1,nlev+1 - sum_up = 0.0_jprb - sum_dn = 0.0_jprb - !$omp simd reduction(+:sum_up, sum_dn) - do jg = 1,ng - sum_up = sum_up + flux_up_clear(jg,jlev) - sum_dn = sum_dn + flux_dn_clear(jg,jlev) - end do - flux%lw_up_clear(jcol,jlev) = sum_up - flux%lw_dn_clear(jcol,jlev) = sum_dn - end do - + flux%lw_up_clear(jcol,:) = sum(flux_up_clear,1) + flux%lw_dn_clear(jcol,:) = sum(flux_dn_clear,1) ! Store surface spectral downwelling fluxes / TOA upwelling - do jg = 1,ng - flux%lw_dn_surf_clear_g(jg,jcol) = flux_dn_clear(jg,nlev+1) - flux%lw_up_toa_clear_g (jg,jcol) = flux_up_clear(jg,1) - end do + flux%lw_dn_surf_clear_g(:,jcol) = flux_dn_clear(:,nlev+1) + flux%lw_up_toa_clear_g (:,jcol) = flux_up_clear(:,1) ! Save the spectral fluxes if required if (config%do_save_spectral_flux) then do jlev = 1,nlev+1 @@ -467,12 +452,7 @@ subroutine solver_tripleclouds_lw(nlev,istartcol,iendcol, & flux%lw_dn_band(:,jcol,jlev) = flux%lw_dn_clear_band(:,jcol,jlev) end if else - sum_dn = 0.0_jprb - !$omp simd reduction(+:sum_dn) - do jg = 1,ng - sum_dn = sum_dn + flux_dn_clear(jg,jlev) - end do - flux%lw_dn(jcol,jlev) = sum_dn + flux%lw_dn(jcol,:) = sum(flux_dn_clear(:,jlev)) if (config%do_save_spectral_flux) then call indexed_sum(flux_dn_clear(:,jlev), & & config%i_spec_from_reordered_g_lw, & @@ -489,14 +469,7 @@ subroutine solver_tripleclouds_lw(nlev,istartcol,iendcol, & flux_up(:,1) = total_source(:,1,i_cloud_top) & & + total_albedo(:,1,i_cloud_top)*flux_dn_clear(:,i_cloud_top) flux_up(:,2:) = 0.0_jprb - - sum_up = 0.0_jprb - !$omp simd reduction(+:sum_up) - do jg = 1,ng - sum_up = sum_up + flux_up(jg,1) - end do - flux%lw_up(jcol,i_cloud_top) = sum_up - + flux%lw_up(jcol,i_cloud_top) = sum(flux_up(:,1)) if (config%do_save_spectral_flux) then call indexed_sum(flux_up(:,1), & & config%i_spec_from_reordered_g_lw, & @@ -504,12 +477,7 @@ subroutine solver_tripleclouds_lw(nlev,istartcol,iendcol, & end if do jlev = i_cloud_top-1,1,-1 flux_up(:,1) = trans_clear(:,jlev)*flux_up(:,1) + source_up_clear(:,jlev) - sum_up = 0.0_jprb - !$omp simd reduction(+:sum_up) - do jg = 1,ng - sum_up = sum_up + flux_up(jg,1) - end do - flux%lw_up(jcol,jlev) = sum_up + flux%lw_up(jcol,jlev) = sum(flux_up(:,1)) if (config%do_save_spectral_flux) then call indexed_sum(flux_up(:,1), & & config%i_spec_from_reordered_g_lw, & @@ -559,17 +527,8 @@ subroutine solver_tripleclouds_lw(nlev,istartcol,iendcol, & ! nothing to do ! Store the broadband fluxes - sum_up = 0.0_jprb - sum_dn = 0.0_jprb - do jreg = 1,nregions - !$omp simd reduction(+:sum_up, sum_dn) - do jg = 1,ng - sum_up = sum_up + flux_up(jg,jreg) - sum_dn = sum_dn + flux_dn(jg,jreg) - end do - end do - flux%lw_up(jcol,jlev+1) = sum_up - flux%lw_dn(jcol,jlev+1) = sum_dn + flux%lw_up(jcol,jlev+1) = sum(sum(flux_up,1)) + flux%lw_dn(jcol,jlev+1) = sum(sum(flux_dn,1)) ! Save the spectral fluxes if required if (config%do_save_spectral_flux) then diff --git a/radiation/radiation_tripleclouds_sw.F90 b/radiation/radiation_tripleclouds_sw.F90 index c2c0fb0a..5fd007ea 100644 --- a/radiation/radiation_tripleclouds_sw.F90 +++ b/radiation/radiation_tripleclouds_sw.F90 @@ -73,13 +73,14 @@ subroutine solver_tripleclouds_sw(nlev,istartcol,iendcol, & ! Gas and aerosol optical depth, single-scattering albedo and ! asymmetry factor at each shortwave g-point - real(jprb), intent(in), dimension(config%n_g_sw,nlev,istartcol:iendcol) & - & :: od, ssa, g +! real(jprb), intent(in), dimension(istartcol:iendcol,nlev,config%n_g_sw) :: & + real(jprb), intent(in), dimension(config%n_g_sw,nlev,istartcol:iendcol) :: & + & od, ssa, g ! Cloud and precipitation optical depth, single-scattering albedo and ! asymmetry factor in each shortwave band - real(jprb), intent(in), dimension(config%n_bands_sw,nlev,istartcol:iendcol) & - & :: od_cloud, ssa_cloud, g_cloud + real(jprb), intent(in), dimension(config%n_bands_sw,nlev,istartcol:iendcol) :: & + & od_cloud, ssa_cloud, g_cloud ! Optical depth, single scattering albedo and asymmetry factor in ! each g-point of each cloudy region including gas, aerosol and @@ -90,8 +91,8 @@ subroutine solver_tripleclouds_sw(nlev,istartcol,iendcol, & ! Direct and diffuse surface albedos, and the incoming shortwave ! flux into a plane perpendicular to the incoming radiation at ! top-of-atmosphere in each of the shortwave g points - real(jprb), intent(in), dimension(config%n_g_sw,istartcol:iendcol) & - & :: albedo_direct, albedo_diffuse, incoming_sw + real(jprb), intent(in), dimension(config%n_g_sw,istartcol:iendcol) :: & + & albedo_direct, albedo_diffuse, incoming_sw ! Output type(flux_type), intent(inout):: flux @@ -164,10 +165,6 @@ subroutine solver_tripleclouds_sw(nlev,istartcol,iendcol, & ! Scattering optical depth of gas+aerosol and of cloud real(jprb) :: scat_od, scat_od_cloud - ! Temporaries to speed up summations - real(jprb) :: sum_dn_diff, sum_dn_dir, sum_up - - ! Local cosine of solar zenith angle real(jprb) :: mu0 integer :: jcol, jlev, jg, jreg, iband, jreg2, ng @@ -446,35 +443,15 @@ subroutine solver_tripleclouds_sw(nlev,istartcol,iendcol, & flux%sw_up_toa_clear_g(:,jcol) = flux_up_clear end if - ! Store the TOA broadband fluxes, noting that there is no - ! diffuse downwelling at TOA. The intrinsic "sum" command has - ! been found to be very slow; better performance is found on - ! x86-64 architecture with explicit loops and the "omp simd - ! reduction" directive. - sum_up = 0.0_jprb - sum_dn_dir = 0.0_jprb - do jreg = 1,nregions - !$omp simd reduction(+:sum_up, sum_dn_dir) - do jg = 1,ng - sum_up = sum_up + flux_up(jg,jreg) - sum_dn_dir = sum_dn_dir + direct_dn(jg,jreg) - end do - end do - flux%sw_up(jcol,1) = sum_up - flux%sw_dn(jcol,1) = mu0 * sum_dn_dir + ! Store the TOA broadband fluxes + flux%sw_up(jcol,1) = sum(sum(flux_up,1)) + flux%sw_dn(jcol,1) = mu0 * sum(sum(direct_dn,1)) if (allocated(flux%sw_dn_direct)) then flux%sw_dn_direct(jcol,1) = flux%sw_dn(jcol,1) end if if (config%do_clear) then - sum_up = 0.0_jprb - sum_dn_dir = 0.0_jprb - !$omp simd reduction(+:sum_up, sum_dn_dir) - do jg = 1,ng - sum_up = sum_up + flux_up_clear(jg) - sum_dn_dir = sum_dn_dir + direct_dn_clear(jg) - end do - flux%sw_up_clear(jcol,1) = sum_up - flux%sw_dn_clear(jcol,1) = mu0 * sum_dn_dir + flux%sw_up_clear(jcol,1) = sum(flux_up_clear) + flux%sw_dn_clear(jcol,1) = mu0 * sum(direct_dn_clear) if (allocated(flux%sw_dn_direct_clear)) then flux%sw_dn_direct_clear(jcol,1) = flux%sw_dn_clear(jcol,1) end if @@ -489,7 +466,8 @@ subroutine solver_tripleclouds_sw(nlev,istartcol,iendcol, & call indexed_sum(sum(direct_dn,2), & & config%i_spec_from_reordered_g_sw, & & flux%sw_dn_band(:,jcol,1)) - flux%sw_dn_band(:,jcol,1) = mu0 * flux%sw_dn_band(:,jcol,1) + flux%sw_dn_band(:,jcol,1) = & + & mu0 * flux%sw_dn_band(:,jcol,1) if (allocated(flux%sw_dn_direct_band)) then flux%sw_dn_direct_band(:,jcol,1) = flux%sw_dn_band(:,jcol,1) end if @@ -570,40 +548,24 @@ subroutine solver_tripleclouds_sw(nlev,istartcol,iendcol, & end if ! Otherwise the fluxes in each region are the same so ! nothing to do - ! Store the broadband fluxes. The intrinsic "sum" command has - ! been found to be very slow; better performance is found on - ! x86-64 architecture with explicit loops and the "omp simd - ! reduction" directive. - sum_up = 0.0_jprb - sum_dn_dir = 0.0_jprb - sum_dn_diff = 0.0_jprb - do jreg = 1,nregions - !$omp simd reduction(+:sum_up, sum_dn_diff, sum_dn_dir) - do jg = 1,ng - sum_up = sum_up + flux_up(jg,jreg) - sum_dn_diff = sum_dn_diff + flux_dn(jg,jreg) - sum_dn_dir = sum_dn_dir + direct_dn(jg,jreg) - end do - end do - flux%sw_up(jcol,jlev+1) = sum_up - flux%sw_dn(jcol,jlev+1) = mu0 * sum_dn_dir + sum_dn_diff + ! Store the broadband fluxes + flux%sw_up(jcol,jlev+1) = sum(sum(flux_up,1)) if (allocated(flux%sw_dn_direct)) then - flux%sw_dn_direct(jcol,jlev+1) = mu0 * sum_dn_dir + flux%sw_dn_direct(jcol,jlev+1) = mu0 * sum(sum(direct_dn,1)) + flux%sw_dn(jcol,jlev+1) & + & = flux%sw_dn_direct(jcol,jlev+1) + sum(sum(flux_dn,1)) + else + flux%sw_dn(jcol,jlev+1) = mu0 * sum(sum(direct_dn,1)) + sum(sum(flux_dn,1)) end if if (config%do_clear) then - sum_up = 0.0_jprb - sum_dn_dir = 0.0_jprb - sum_dn_diff = 0.0_jprb - !$omp simd reduction(+:sum_up, sum_dn_diff, sum_dn_dir) - do jg = 1,ng - sum_up = sum_up + flux_up_clear(jg) - sum_dn_diff = sum_dn_diff + flux_dn_clear(jg) - sum_dn_dir = sum_dn_dir + direct_dn_clear(jg) - end do - flux%sw_up_clear(jcol,jlev+1) = sum_up - flux%sw_dn_clear(jcol,jlev+1) = mu0 * sum_dn_dir + sum_dn_diff + flux%sw_up_clear(jcol,jlev+1) = sum(flux_up_clear) if (allocated(flux%sw_dn_direct_clear)) then - flux%sw_dn_direct_clear(jcol,jlev+1) = mu0 * sum_dn_dir + flux%sw_dn_direct_clear(jcol,jlev+1) = mu0 * sum(direct_dn_clear) + flux%sw_dn_clear(jcol,jlev+1) & + & = flux%sw_dn_direct_clear(jcol,jlev+1) + sum(flux_dn_clear) + else + flux%sw_dn_clear(jcol,jlev+1) = mu0 * sum(direct_dn_clear) & + & + sum(flux_dn_clear) end if end if @@ -642,6 +604,7 @@ subroutine solver_tripleclouds_sw(nlev,istartcol,iendcol, & & flux%sw_dn_clear_band(:,jcol,jlev+1)) end if end if + end do ! Final loop over levels ! Store surface spectral fluxes, if required (after the end of diff --git a/radiation/radiation_two_stream.F90 b/radiation/radiation_two_stream.F90 index df376419..82c75358 100644 --- a/radiation/radiation_two_stream.F90 +++ b/radiation/radiation_two_stream.F90 @@ -20,8 +20,7 @@ ! 2021-02-19 R Hogan Security for shortwave singularity ! 2022-11-22 P Ukkonen/R Hogan Single precision uses no double precision ! 2023-09-28 R Hogan Increased security for single-precision SW "k" - -#include "ecrad_config.h" +! 2025-08-06 R. El Khatib Optimization module radiation_two_stream @@ -154,7 +153,7 @@ subroutine calc_reflectance_transmittance_lw(ng, & #endif implicit none - + integer, intent(in) :: ng ! Optical depth and single scattering albedo @@ -205,7 +204,7 @@ subroutine calc_reflectance_transmittance_lw(ng, & reflectance(jg) = gamma2(jg) * (1.0_jprd - exponential2) * reftrans_factor ! Meador & Weaver (1980) Eq. 26 transmittance(jg) = 2.0_jprd * k_exponent * exponential * reftrans_factor - + ! Compute upward and downward emission assuming the Planck ! function to vary linearly with optical depth within the layer ! (e.g. Wiscombe , JQSRT 1976). @@ -228,13 +227,13 @@ subroutine calc_reflectance_transmittance_lw(ng, & source_dn(jg) = source_up(jg) end if end do - + #ifdef DO_DR_HOOK_TWO_STREAM if (lhook) call dr_hook('radiation_two_stream:calc_reflectance_transmittance_lw',1,hook_handle) #endif - + end subroutine calc_reflectance_transmittance_lw - + !--------------------------------------------------------------------- ! Compute the longwave reflectance and transmittance to diffuse @@ -290,6 +289,8 @@ subroutine calc_ref_trans_lw(ng, & if (lhook) call dr_hook('radiation_two_stream:calc_ref_trans_lw',0,hook_handle) #endif +! Added for DWD (2020) +!NEC$ shortloop do jg = 1, ng factor = (LwDiffusivityWP * 0.5_jprb) * ssa(jg) gamma1 = LwDiffusivityWP - factor*(1.0_jprb + asymmetry(jg)) @@ -304,7 +305,7 @@ subroutine calc_ref_trans_lw(ng, & reflectance(jg) = gamma2 * (1.0_jprb - exponential2) * reftrans_factor ! Meador & Weaver (1980) Eq. 26 transmittance(jg) = 2.0_jprb * k_exponent * exponential * reftrans_factor - + ! Compute upward and downward emission assuming the Planck ! function to vary linearly with optical depth within the layer ! (e.g. Wiscombe , JQSRT 1976). @@ -325,14 +326,14 @@ subroutine calc_ref_trans_lw(ng, & source_dn(jg) = source_up(jg) end if end do - + #ifdef DO_DR_HOOK_TWO_STREAM if (lhook) call dr_hook('radiation_two_stream:calc_ref_trans_lw',1,hook_handle) #endif - + end subroutine calc_ref_trans_lw - - + + !--------------------------------------------------------------------- ! Compute the longwave transmittance to diffuse radiation in the ! no-scattering case, as well as the upward flux at the top and the @@ -374,18 +375,15 @@ subroutine calc_no_scattering_transmittance_lw(ng, & if (lhook) call dr_hook('radiation_two_stream:calc_no_scattering_transmittance_lw',0,hook_handle) #endif -#ifndef DWD_TWO_STREAM_OPTIMIZATIONS transmittance = exp(-LwDiffusivityWP*od) -#endif +! Added for DWD (2020) +!NEC$ shortloop do jg = 1, ng ! Compute upward and downward emission assuming the Planck ! function to vary linearly with optical depth within the layer ! (e.g. Wiscombe , JQSRT 1976). coeff = LwDiffusivityWP*od(jg) -#ifdef DWD_TWO_STREAM_OPTIMIZATIONS - transmittance(jg) = exp(-coeff) -#endif if (od(jg) > 1.0e-3_jprb) then ! Simplified from calc_reflectance_transmittance_lw above coeff = (planck_bot(jg)-planck_top(jg)) / coeff @@ -407,8 +405,8 @@ subroutine calc_no_scattering_transmittance_lw(ng, & #endif end subroutine calc_no_scattering_transmittance_lw - - + + !--------------------------------------------------------------------- ! Compute the shortwave reflectance and transmittance to diffuse ! radiation using the Meador & Weaver formulas, as well as the @@ -421,7 +419,7 @@ end subroutine calc_no_scattering_transmittance_lw subroutine calc_reflectance_transmittance_sw(ng, mu0, od, ssa, & & gamma1, gamma2, gamma3, ref_diff, trans_diff, & & ref_dir, trans_dir_diff, trans_dir_dir) - + #ifdef DO_DR_HOOK_TWO_STREAM use yomhook, only : lhook, dr_hook, jphook #endif @@ -504,34 +502,34 @@ subroutine calc_reflectance_transmittance_sw(ng, mu0, od, ssa, & exponential0 = exp(-od_over_mu0) trans_dir_dir(jg) = exponential0 exponential = exp(-k_exponent*od(jg)) - + exponential2 = exponential*exponential k_2_exponential = 2.0_jprd * k_exponent * exponential - + reftrans_factor = 1.0_jprd / (k_exponent + gamma1(jg) + (k_exponent - gamma1(jg))*exponential2) - + ! Meador & Weaver (1980) Eq. 25 ref_diff(jg) = gamma2(jg) * (1.0_jprd - exponential2) * reftrans_factor - + ! Meador & Weaver (1980) Eq. 26 trans_diff(jg) = k_2_exponential * reftrans_factor - + ! Here we need mu0 even though it wasn't in Meador and Weaver ! because we are assuming the incoming direct flux is defined ! to be the flux into a plane perpendicular to the direction of ! the sun, not into a horizontal plane reftrans_factor = mu0_local * ssa(jg) * reftrans_factor / (1.0_jprd - k_mu0*k_mu0) - + ! Meador & Weaver (1980) Eq. 14, multiplying top & bottom by ! exp(-k_exponent*od) in case of very high optical depths ref_dir(jg) = reftrans_factor & & * ( (1.0_jprd - k_mu0) * (alpha2 + k_gamma3) & & -(1.0_jprd + k_mu0) * (alpha2 - k_gamma3)*exponential2 & & -k_2_exponential*(gamma3(jg) - alpha2*mu0_local)*exponential0) - + ! Meador & Weaver (1980) Eq. 15, multiplying top & bottom by ! exp(-k_exponent*od), minus the 1*exp(-od/mu0) term representing direct - ! unscattered transmittance. + ! unscattered transmittance. trans_dir_diff(jg) = reftrans_factor * ( k_2_exponential*(gamma4 + alpha1*mu0_local) & & - exponential0 & & * ( (1.0_jprd + k_mu0) * (alpha1 + k_gamma4) & @@ -542,11 +540,11 @@ subroutine calc_reflectance_transmittance_sw(ng, mu0, od, ssa, & trans_dir_diff(jg) = max(0.0_jprb, min(trans_dir_diff(jg), 1.0_jprb-ref_dir(jg))) end do - + #ifdef DO_DR_HOOK_TWO_STREAM if (lhook) call dr_hook('radiation_two_stream:calc_reflectance_transmittance_sw',1,hook_handle) #endif - + end subroutine calc_reflectance_transmittance_sw @@ -563,13 +561,13 @@ end subroutine calc_reflectance_transmittance_sw subroutine calc_ref_trans_sw(ng, mu0, od, ssa, & & asymmetry, ref_diff, trans_diff, & & ref_dir, trans_dir_diff, trans_dir_dir) - + #ifdef DO_DR_HOOK_TWO_STREAM use yomhook, only : lhook, dr_hook, jphook #endif implicit none - + integer, intent(in) :: ng ! Cosine of solar zenith angle @@ -593,21 +591,16 @@ subroutine calc_ref_trans_sw(ng, mu0, od, ssa, & real(jprb), intent(out), dimension(ng) :: trans_dir_dir ! The three transfer coefficients from the two-stream - ! differentiatial equations -#ifndef DWD_TWO_STREAM_OPTIMIZATIONS - real(jprb), dimension(ng) :: gamma1, gamma2, gamma3, gamma4 + ! differentiatial equations + real(jprb), dimension(ng) :: gamma1, gamma2, gamma3, gamma4 real(jprb), dimension(ng) :: alpha1, alpha2, k_exponent real(jprb), dimension(ng) :: exponential ! = exp(-k_exponent*od) -#else - real(jprb) :: gamma1, gamma2, gamma3, gamma4 - real(jprb) :: alpha1, alpha2, k_exponent - real(jprb) :: exponential ! = exp(-k_exponent*od) -#endif - + real(jprb) :: reftrans_factor, factor real(jprb) :: exponential2 ! = exp(-2*k_exponent*od) real(jprb) :: k_mu0, k_gamma3, k_gamma4 real(jprb) :: k_2_exponential, one_minus_kmu0_sqr + real(jprb) :: reverse_mu0 integer :: jg #ifdef DO_DR_HOOK_TWO_STREAM @@ -616,13 +609,15 @@ subroutine calc_ref_trans_sw(ng, mu0, od, ssa, & if (lhook) call dr_hook('radiation_two_stream:calc_ref_trans_sw',0,hook_handle) #endif -#ifndef DWD_TWO_STREAM_OPTIMIZATIONS ! GCC 9.3 strange error: intermediate values of ~ -8000 cause a ! FPE when vectorizing exp(), but not in non-vectorized loop, nor ! with larger negative values! - trans_dir_dir = max(-max(od * (1.0_jprb/mu0), 0.0_jprb),-1000.0_jprb) + reverse_mu0=1.0_jprb/mu0 + trans_dir_dir = max(-max(od * reverse_mu0, 0.0_jprb),-1000.0_jprb) trans_dir_dir = exp(trans_dir_dir) +! Added for DWD (2020) +!NEC$ shortloop do jg = 1, ng ! Zdunkowski "PIFM" (Zdunkowski et al., 1980; Contributions to @@ -651,6 +646,7 @@ subroutine calc_ref_trans_sw(ng, mu0, od, ssa, & exponential = exp(-k_exponent*od) +!NEC$ shortloop do jg = 1, ng k_mu0 = k_exponent(jg)*mu0 one_minus_kmu0_sqr = 1.0_jprb - k_mu0*k_mu0 @@ -659,7 +655,7 @@ subroutine calc_ref_trans_sw(ng, mu0, od, ssa, & exponential2 = exponential(jg)*exponential(jg) k_2_exponential = 2.0_jprb * k_exponent(jg) * exponential(jg) reftrans_factor = 1.0_jprb / (k_exponent(jg) + gamma1(jg) + (k_exponent(jg) - gamma1(jg))*exponential2) - + ! Meador & Weaver (1980) Eq. 25 ref_diff(jg) = gamma2(jg) * (1.0_jprb - exponential2) * reftrans_factor !ref_diff(jg) = max(0.0_jprb, min(ref_diff(jg)), 1.0_jprb) @@ -674,14 +670,14 @@ subroutine calc_ref_trans_sw(ng, mu0, od, ssa, & ! sun, not into a horizontal plane reftrans_factor = mu0 * ssa(jg) * reftrans_factor & & / merge(one_minus_kmu0_sqr, epsilon(1.0_jprb), abs(one_minus_kmu0_sqr) > epsilon(1.0_jprb)) - + ! Meador & Weaver (1980) Eq. 14, multiplying top & bottom by ! exp(-k_exponent*od) in case of very high optical depths ref_dir(jg) = reftrans_factor & & * ( (1.0_jprb - k_mu0) * (alpha2(jg) + k_gamma3) & & -(1.0_jprb + k_mu0) * (alpha2(jg) - k_gamma3)*exponential2 & & -k_2_exponential*(gamma3(jg) - alpha2(jg)*mu0)*trans_dir_dir(jg) ) - + ! Meador & Weaver (1980) Eq. 15, multiplying top & bottom by ! exp(-k_exponent*od), minus the 1*exp(-od/mu0) term ! representing direct unscattered transmittance. @@ -694,90 +690,21 @@ subroutine calc_ref_trans_sw(ng, mu0, od, ssa, & ref_dir(jg) = max(0.0_jprb, min(ref_dir(jg), mu0*(1.0_jprb-trans_dir_dir(jg)))) trans_dir_diff(jg) = max(0.0_jprb, min(trans_dir_diff(jg), mu0*(1.0_jprb-trans_dir_dir(jg))-ref_dir(jg))) end do - -#else - ! GPU-capable and vector-optimized version for ICON - do jg = 1, ng - - trans_dir_dir(jg) = max(-max(od(jg) * (1.0_jprb/mu0),0.0_jprb),-1000.0_jprb) - trans_dir_dir(jg) = exp(trans_dir_dir(jg)) - - ! Zdunkowski "PIFM" (Zdunkowski et al., 1980; Contributions to - ! Atmospheric Physics 53, 147-66) - factor = 0.75_jprb*asymmetry(jg) - - gamma1 = 2.0_jprb - ssa(jg) * (1.25_jprb + factor) - gamma2 = ssa(jg) * (0.75_jprb - factor) - gamma3 = 0.5_jprb - mu0*factor - gamma4 = 1.0_jprb - gamma3 - - alpha1 = gamma1*gamma4 + gamma2*gamma3 ! Eq. 16 - alpha2 = gamma1*gamma3 + gamma2*gamma4 ! Eq. 17 -#ifdef PARKIND1_SINGLE - k_exponent = sqrt(max((gamma1 - gamma2) * (gamma1 + gamma2), 1.0e-6_jprb)) ! Eq 18 -#else - k_exponent = sqrt(max((gamma1 - gamma2) * (gamma1 + gamma2), 1.0e-12_jprb)) ! Eq 18 -#endif - - exponential = exp(-k_exponent*od(jg)) - - k_mu0 = k_exponent*mu0 - one_minus_kmu0_sqr = 1.0_jprb - k_mu0*k_mu0 - k_gamma3 = k_exponent*gamma3 - k_gamma4 = k_exponent*gamma4 - exponential2 = exponential*exponential - k_2_exponential = 2.0_jprb * k_exponent * exponential - reftrans_factor = 1.0_jprb / (k_exponent + gamma1 + (k_exponent - gamma1)*exponential2) - - ! Meador & Weaver (1980) Eq. 25 - ref_diff(jg) = gamma2 * (1.0_jprb - exponential2) * reftrans_factor - - ! Meador & Weaver (1980) Eq. 26 - trans_diff(jg) = k_2_exponential * reftrans_factor - - ! Here we need mu0 even though it wasn't in Meador and Weaver - ! because we are assuming the incoming direct flux is defined to - ! be the flux into a plane perpendicular to the direction of the - ! sun, not into a horizontal plane - reftrans_factor = mu0 * ssa(jg) * reftrans_factor & - & / merge(one_minus_kmu0_sqr, epsilon(1.0_jprb), abs(one_minus_kmu0_sqr) > epsilon(1.0_jprb)) - - ! Meador & Weaver (1980) Eq. 14, multiplying top & bottom by - ! exp(-k_exponent*od) in case of very high optical depths - ref_dir(jg) = reftrans_factor & - & * ( (1.0_jprb - k_mu0) * (alpha2 + k_gamma3) & - & -(1.0_jprb + k_mu0) * (alpha2 - k_gamma3)*exponential2 & - & -k_2_exponential*(gamma3 - alpha2*mu0)*trans_dir_dir(jg) ) - - ! Meador & Weaver (1980) Eq. 15, multiplying top & bottom by - ! exp(-k_exponent*od), minus the 1*exp(-od/mu0) term - ! representing direct unscattered transmittance. - trans_dir_diff(jg) = reftrans_factor * ( k_2_exponential*(gamma4 + alpha1*mu0) & - & - trans_dir_dir(jg) & - & * ( (1.0_jprb + k_mu0) * (alpha1 + k_gamma4) & - & -(1.0_jprb - k_mu0) * (alpha1 - k_gamma4) * exponential2) ) - - ! Final check that ref_dir + trans_dir_diff <= 1 - ref_dir(jg) = max(0.0_jprb, min(ref_dir(jg), mu0*(1.0_jprb-trans_dir_dir(jg)))) - trans_dir_diff(jg) = max(0.0_jprb, min(trans_dir_diff(jg), mu0*(1.0_jprb-trans_dir_dir(jg))-ref_dir(jg))) - - end do -#endif - + #ifdef DO_DR_HOOK_TWO_STREAM if (lhook) call dr_hook('radiation_two_stream:calc_ref_trans_sw',1,hook_handle) #endif - + end subroutine calc_ref_trans_sw - + !--------------------------------------------------------------------- ! Compute the fraction of shortwave transmitted diffuse radiation ! that is scattered during its transmission, used to compute ! entrapment in SPARTACUS subroutine calc_frac_scattered_diffuse_sw(ng, od, & & gamma1, gamma2, frac_scat_diffuse) - + #ifdef DO_DR_HOOK_TWO_STREAM use yomhook, only : lhook, dr_hook, jphook #endif @@ -818,9 +745,9 @@ subroutine calc_frac_scattered_diffuse_sw(ng, od, & exponential = exp(-k_exponent*od(jg)) exponential2 = exponential*exponential k_2_exponential = 2.0_jprd * k_exponent * exponential - + reftrans_factor = 1.0_jprd / (k_exponent + gamma1(jg) + (k_exponent - gamma1(jg))*exponential2) - + ! Meador & Weaver (1980) Eq. 26. ! Until 1.1.8, used LwDiffusivity instead of 2.0, although the ! effect is very small @@ -830,11 +757,11 @@ subroutine calc_frac_scattered_diffuse_sw(ng, od, & & - min(1.0_jprb,exp(-2.0_jprb*od(jg)) & & / max(1.0e-8_jprb, k_2_exponential * reftrans_factor)) end do - + #ifdef DO_DR_HOOK_TWO_STREAM if (lhook) call dr_hook('radiation_two_stream:calc_frac_scattered_diffuse_sw',1,hook_handle) #endif - + end subroutine calc_frac_scattered_diffuse_sw end module radiation_two_stream diff --git a/utilities/easy_netcdf.F90 b/utilities/easy_netcdf.F90 index 7e2ac317..3c771ee3 100644 --- a/utilities/easy_netcdf.F90 +++ b/utilities/easy_netcdf.F90 @@ -21,10 +21,12 @@ ! 2019-01-16 R. Hogan Revised interpretation of "iverbose" ! 2019-06-17 R. Hogan Pass through deflate_level and shuffle to variable definition ! 2021-03-15 O. Marsden Add 'first-touch' option to the 4D array get method, to allow improved OpenMP access to arrays. +! 2024-08-05 R. El khatib and then use array syntax to let the compilers use fast memeset. module easy_netcdf + use netcdf use parkind1, only : jprb, jpib, jprm, jprd use radiation_io, only : nulout, nulerr, my_abort => radiation_abort @@ -65,7 +67,6 @@ module easy_netcdf procedure :: get_real_scalar_indexed procedure :: get_real_vector_indexed procedure :: get_real_matrix_indexed - procedure :: get_real_matrix_indexed2 procedure :: get_real_array3_indexed procedure :: get_real_array3_indexed2 procedure :: get_real_array4 @@ -77,7 +78,7 @@ module easy_netcdf & get_real_array4, & & get_real_scalar_indexed, get_real_vector_indexed, & & get_real_matrix_indexed, get_real_array3_indexed, & - & get_real_matrix_indexed2, get_real_array3_indexed2, & + & get_real_array3_indexed2, & & get_char_vector, get_char_matrix procedure :: get_real_scalar_attribute procedure :: get_string_attribute @@ -131,9 +132,6 @@ module easy_netcdf ! verbosity level (0-5) and if the file is for writing (the default ! is read-only) subroutine open_netcdf_file(this, file_name, iverbose, is_write_mode, is_hdf5_file) - use netcdf, only: NF90_CLOBBER, NF90_HDF5, NF90_NOERR, NF90_NOWRITE, & - & nf90_create, nf90_open, nf90_strerror - class(netcdf_file) :: this character(len=*), intent(in) :: file_name integer, intent(in), optional :: iverbose @@ -210,9 +208,6 @@ end subroutine open_netcdf_file !--------------------------------------------------------------------- ! Open a NetCDF file for writing subroutine create_netcdf_file(this, file_name, iverbose, is_hdf5_file) - use netcdf, only: NF90_CLOBBER, NF90_HDF5, NF90_NOERR, & - & nf90_create, nf90_strerror - class(netcdf_file) :: this character(len=*), intent(in) :: file_name integer, intent(in), optional :: iverbose @@ -264,8 +259,6 @@ end subroutine create_netcdf_file !--------------------------------------------------------------------- ! Close the NetCDF file subroutine close_netcdf_file(this) - use netcdf, only: NF90_NOERR, nf90_close, nf90_strerror - class(netcdf_file) :: this integer :: istatus @@ -364,8 +357,6 @@ end subroutine permute_4d_arrays ! Return the NetCDF variable ID for variable "var_name", or abort if ! not present subroutine get_variable_id(this, var_name, ivarid) - use netcdf, only: NF90_NOERR, nf90_inq_varid, nf90_strerror - class(netcdf_file) :: this character(len=*), intent(in) :: var_name integer, intent(out) :: ivarid @@ -387,9 +378,6 @@ end subroutine get_variable_id ! with the number of dimensions and optionally the total number of ! elements, or abort if variable not present subroutine get_array_dimensions(this, ivarid, ndims, ndimlens, ntotal) - use netcdf, only: NF90_MAX_VAR_DIMS, NF90_NOERR, & - & nf90_inquire_variable, nf90_inquire_dimension, nf90_strerror - class(netcdf_file) :: this integer, intent(in) :: ivarid integer, intent(out) :: ndims @@ -433,8 +421,6 @@ end subroutine get_array_dimensions ! (errors are possible if variables are too large for the format, ! for example) subroutine end_define_mode(this) - use netcdf, only: NF90_NOERR, nf90_enddef, nf90_strerror - class(netcdf_file) :: this integer :: istatus if (this%is_define_mode) then @@ -463,9 +449,6 @@ end function is_open ! Return the number of dimensions of variable with name var_name, or ! -1 if the variable is not found function get_rank(this, var_name) result(ndims) - use netcdf, only: NF90_MAX_VAR_DIMS, NF90_NOERR, NF90_ENOTVAR, & - & nf90_inq_varid, nf90_strerror - class(netcdf_file) :: this character(len=*), intent(in) :: var_name @@ -497,9 +480,6 @@ end function get_rank ! Return the length of the slowest-varying dimension of variable ! with name var_name, or -1 if the variable is not found function get_outer_dimension(this, var_name) result(n) - use netcdf, only: NF90_MAX_VAR_DIMS, NF90_NOERR, NF90_ENOTVAR, & - & nf90_inq_varid, nf90_strerror - class(netcdf_file) :: this character(len=*), intent(in) :: var_name @@ -532,8 +512,6 @@ end function get_outer_dimension !--------------------------------------------------------------------- ! Return true if the variable is present, false otherwise function exists(this, var_name) result(is_present) - use netcdf, only: NF90_NOERR, nf90_inq_varid - class(netcdf_file) :: this character(len=*), intent(in) :: var_name @@ -559,8 +537,6 @@ end function exists ! fixed array size and want to check whether the attribute will fit ! into it. function attribute_exists(this, var_name, attr_name, len) result(is_present) - use netcdf, only: NF90_NOERR, nf90_inquire_attribute, nf90_inq_varid - class(netcdf_file) :: this character(len=*), intent(in) :: var_name, attr_name integer, optional, intent(in) :: len @@ -577,7 +553,7 @@ function attribute_exists(this, var_name, attr_name, len) result(is_present) & len=i_attr_len) if (istatus /= NF90_NOERR) then is_present = .false. - else + else is_present = .true. if (present(len)) then if (i_attr_len > len) then @@ -597,8 +573,6 @@ end function attribute_exists ! fixed array size and want to check whether the attribute will fit ! into it. function global_attribute_exists(this, attr_name, len) result(is_present) - use netcdf, only: NF90_NOERR, NF90_GLOBAL, nf90_inquire_attribute - class(netcdf_file) :: this character(len=*), intent(in) :: attr_name integer, optional, intent(in) :: len @@ -611,7 +585,7 @@ function global_attribute_exists(this, attr_name, len) result(is_present) & len=i_attr_len) if (istatus /= NF90_NOERR) then is_present = .false. - else + else is_present = .true. if (present(len)) then if (i_attr_len > len) then @@ -628,8 +602,6 @@ end function global_attribute_exists ! depending on the rank of the output argument. This version reads a ! scalar. subroutine get_real_scalar(this, var_name, scalar) - use netcdf, only: NF90_MAX_VAR_DIMS, NF90_NOERR, nf90_get_var, nf90_strerror - class(netcdf_file) :: this character(len=*), intent(in) :: var_name real(jprb), intent(out) :: scalar @@ -675,8 +647,6 @@ end subroutine get_real_scalar !--------------------------------------------------------------------- ! Read an integer scalar subroutine get_int_scalar(this, var_name, scalar) - use netcdf, only: NF90_MAX_VAR_DIMS, NF90_NOERR, nf90_get_var, nf90_strerror - class(netcdf_file) :: this character(len=*), intent(in) :: var_name integer, intent(out):: scalar @@ -723,8 +693,6 @@ end subroutine get_int_scalar ! Read a scalar from a larger array, where "index" indexes the most ! slowly varying dimension subroutine get_real_scalar_indexed(this, var_name, scalar, index) - use netcdf, only: NF90_MAX_VAR_DIMS, NF90_NOERR, nf90_get_var, nf90_strerror - class(netcdf_file) :: this character(len=*), intent(in) :: var_name integer, intent(in) :: index @@ -782,8 +750,6 @@ end subroutine get_real_scalar_indexed ! Read a 1D real array into "vector", which must be allocatable and ! will be reallocated if necessary subroutine get_real_vector(this, var_name, vector) - use netcdf, only: NF90_MAX_VAR_DIMS, NF90_NOERR, nf90_get_var, nf90_strerror - class(netcdf_file) :: this character(len=*), intent(in) :: var_name real(jprb), allocatable, intent(out) :: vector(:) @@ -842,8 +808,6 @@ end subroutine get_real_vector ! Read a 1D character array into "vector", which must be allocatable ! and will be reallocated if necessary subroutine get_char_vector(this, var_name, vector) - use netcdf, only: NF90_MAX_VAR_DIMS, NF90_NOERR, nf90_get_var, nf90_strerror - class(netcdf_file) :: this character(len=*), intent(in) :: var_name character(len=1), allocatable, intent(out) :: vector(:) @@ -902,7 +866,6 @@ end subroutine get_char_vector ! Read a 1D integer array into "vector", which must be allocatable ! and will be reallocated if necessary subroutine get_int_vector(this, var_name, vector) - use netcdf, only: NF90_MAX_VAR_DIMS, NF90_NOERR, nf90_get_var, nf90_strerror class(netcdf_file) :: this character(len=*), intent(in) :: var_name @@ -961,8 +924,6 @@ end subroutine get_int_vector ! Read a vector of data from a larger array; the vector must be ! allocatable and will be reallocated if necessary subroutine get_real_vector_indexed(this, var_name, vector, index) - use netcdf, only: NF90_MAX_VAR_DIMS, NF90_NOERR, nf90_get_var, nf90_strerror - class(netcdf_file) :: this character(len=*), intent(in) :: var_name integer, intent(in) :: index @@ -1038,8 +999,6 @@ end subroutine get_real_vector_indexed ! final optional argument, but can also be specified by the ! do_transpose_2d class data member. subroutine get_real_matrix(this, var_name, matrix, do_transp) - use netcdf, only: NF90_MAX_VAR_DIMS, NF90_NOERR, nf90_get_var, nf90_strerror - class(netcdf_file) :: this character(len=*), intent(in) :: var_name real(jprb), allocatable, intent(out) :: matrix(:,:) @@ -1150,8 +1109,6 @@ end subroutine get_real_matrix ! transpose is specifed by the final optional argument, but can also ! be specified by the do_transpose_2d class data member. subroutine get_char_matrix(this, var_name, matrix, do_transp) - use netcdf, only: NF90_MAX_VAR_DIMS, NF90_NOERR, nf90_get_var, nf90_strerror - class(netcdf_file) :: this character(len=*), intent(in) :: var_name character(len=1), allocatable, intent(inout) :: matrix(:,:) @@ -1248,7 +1205,7 @@ subroutine get_char_matrix(this, var_name, matrix, do_transp) vstart = 1 vcount(1:2) = [ndimlen1,1] - + do j = 1,ndimlen2 vstart(2) = j istatus = nf90_get_var(this%ncid, ivarid, matrix(:,j), start=vstart, count=vcount) @@ -1270,8 +1227,6 @@ end subroutine get_char_matrix ! specifed by the final optional argument, but can also be specified ! by the do_transpose_2d class data member. subroutine get_real_matrix_indexed(this, var_name, matrix, index, do_transp) - use netcdf, only: NF90_MAX_VAR_DIMS, NF90_NOERR, nf90_get_var, nf90_strerror - class(netcdf_file) :: this character(len=*), intent(in) :: var_name integer, intent(in) :: index @@ -1390,146 +1345,11 @@ subroutine get_real_matrix_indexed(this, var_name, matrix, index, do_transp) end subroutine get_real_matrix_indexed - !--------------------------------------------------------------------- - ! Read matrix of data from a larger array, which must be allocatable - ! and will be reallocated if necessary. Whether to transpose is - ! specifed by the final optional argument, but can also be specified - ! by the do_transpose_2d class data member. - subroutine get_real_matrix_indexed2(this, var_name, matrix, index3, index4, do_transp) - use netcdf, only: NF90_MAX_VAR_DIMS, NF90_NOERR, nf90_get_var, nf90_strerror - - class(netcdf_file) :: this - character(len=*), intent(in) :: var_name - integer, intent(in) :: index3, index4 - real(jprb), allocatable, intent(out) :: matrix(:,:) - logical, optional, intent(in):: do_transp ! Transpose data? - - real(jprb), allocatable :: tmp_matrix(:,:) - integer :: ndimlen1, ndimlen2 - integer :: istatus - integer :: ivarid, ndims - integer :: ndimlens(NF90_MAX_VAR_DIMS) - integer :: vstart(NF90_MAX_VAR_DIMS) - integer :: vcount(NF90_MAX_VAR_DIMS) - integer :: j, ntotal - logical :: do_transpose - - ! Decide whether to transpose the array - if (present(do_transp)) then - do_transpose = do_transp - else - do_transpose = this%do_transpose_2d - end if - - call this%get_variable_id(var_name, ivarid) - call this%get_array_dimensions(ivarid, ndims, ndimlens) - - ! Ensure the variable has no more than three non-singleton - ! dimensions aside from the last one - ntotal = 1 - do j = 1, ndims-1 - ntotal = ntotal * ndimlens(j) - if (j > 3 .and. ndimlens(j) > 1) then - write(nulerr,'(a,a,a)') '*** Error reading 2D slice from NetCDF variable ', & - & var_name, & - & ': all dimensions except the first, second, third and last must be singletons' - call my_abort('Error reading NetCDF file') - end if - end do - - if (index3 < 1 .or. index3 > ndimlens(3)) then - write(nulerr,'(a,i0,a,a,a,i0)') '*** Error reading element ', index3, & - & ' of NetCDF variable ', & - & var_name, ' with 4th dimension ', ndimlens(4) - call my_abort('Error reading NetCDF file') - end if - if (index4 < 1 .or. index4 > ndimlens(ndims)) then - write(nulerr,'(a,i0,a,a,a,i0)') '*** Error reading element ', index4, & - & ' of NetCDF variable ', & - & var_name, ' with outer dimension ', ndimlens(ndims) - call my_abort('Error reading NetCDF file') - end if - - ! Work out dimension lengths - if (ndims >= 2) then - ndimlen1 = ndimlens(1) - ndimlen2 = ntotal/ndimlen1 - else - ndimlen1 = ntotal - ndimlen2 = 1 - end if - - vstart(1:ndims-1) = 1 - vstart(3) = index3 - vstart(ndims) = index4 - vcount(1:ndims-1) = ndimlens(1:ndims-1) - vcount(3) = 1 - vcount(ndims) = 1 - - if (do_transpose) then - ! Read and transpose - allocate(tmp_matrix(ndimlen1, ndimlen2)) - - ! Reallocate if necessary - if (allocated(matrix)) then - if (size(matrix,1) /= ndimlen2 .or. size(matrix,2) /= ndimlen1) then - if (this%iverbose >= 1) then - write(nulout,'(a,a)') ' Warning: resizing matrix to read ', var_name - end if - allocate(matrix(ndimlen2, ndimlen1)) - end if - else - allocate(matrix(ndimlen2, ndimlen1)) - end if - - if (this%iverbose >= 3) then - write(nulout,'(a,i0,a,i0,a,a,a,i0,a,i0,a)') ' Reading slice ', index3, ',', index4, & - & ' of ', var_name, ' as ', ndimlen2, 'x', ndimlen1, ' array' - end if - - istatus = nf90_get_var(this%ncid, ivarid, tmp_matrix, & - & start=vstart, count=vcount) - matrix = transpose(tmp_matrix) - deallocate(tmp_matrix) - else - ! Read data without transposition - - ! Reallocate if necessary - if (allocated(matrix)) then - if (size(matrix,1) /= ndimlen1 .or. size(matrix,2) /= ndimlen2) then - if (this%iverbose >= 1) then - write(nulout,'(a,a)') ' Warning: resizing matrix to read ', var_name - end if - allocate(matrix(ndimlen1, ndimlen2)) - end if - else - allocate(matrix(ndimlen1, ndimlen2)) - end if - - if (this%iverbose >= 3) then - write(nulout,'(a,i0,a,i0,a,a,a,i0,a,i0,a)') ' Reading slice ', index3, ',', index4, & - & ' of ', var_name, ' as ', ndimlen1, 'x', ndimlen2, ' array' - end if - - istatus = nf90_get_var(this%ncid, ivarid, matrix, & - & start=vstart, count=vcount) - end if - - if (istatus /= NF90_NOERR) then - write(nulerr,'(a,a,a,a)') '*** Error reading 2D slice of NetCDF variable ', & - & var_name, ': ', trim(nf90_strerror(istatus)) - call my_abort('Error reading NetCDF file') - end if - - end subroutine get_real_matrix_indexed2 - !--------------------------------------------------------------------- ! Read 3D array into "var", which must be allocatable and will be ! reallocated if necessary. Whether to pemute is specifed by the ! final optional argument subroutine get_real_array3(this, var_name, var, ipermute) - use netcdf, only: NF90_MAX_VAR_DIMS, NF90_NOERR, nf90_get_var, nf90_strerror - class(netcdf_file) :: this character(len=*), intent(in) :: var_name real(jprb), allocatable, intent(out) :: var(:,:,:) @@ -1663,8 +1483,6 @@ end subroutine get_real_array3 ! be allocatable and will be reallocated if necessary. Whether to ! pemute is specifed by the final optional argument subroutine get_real_array3_indexed(this, var_name, var, index, ipermute) - use netcdf, only: NF90_MAX_VAR_DIMS, NF90_NOERR, nf90_get_var, nf90_strerror - class(netcdf_file) :: this character(len=*), intent(in) :: var_name integer, intent(in) :: index @@ -1810,8 +1628,6 @@ end subroutine get_real_array3_indexed ! be allocatable and will be reallocated if necessary. Whether to ! pemute is specifed by the final optional argument subroutine get_real_array3_indexed2(this, var_name, var, index4, index5, ipermute) - use netcdf, only: NF90_MAX_VAR_DIMS, NF90_NOERR, nf90_get_var, nf90_strerror - class(netcdf_file) :: this character(len=*), intent(in) :: var_name integer, intent(in) :: index4, index5 @@ -1967,14 +1783,12 @@ end subroutine get_real_array3_indexed2 !--------------------------------------------------------------------- ! Read 4D array into "var", which must be allocatable and will be ! reallocated if necessary. Whether to pemute is specifed by the - ! ipermute optional argument. For the non-permuted case, OpenMP - ! thread-optimized location of array is enabled by setting optional + ! ipermute optional argument. For the non-permuted case, OpenMP + ! thread-optimized location of array is enabled by setting optional ! argument ld_first_touch to true. This results in zero-ing of "var" ! inside an OpenMP loop before reading the array in from NetCDF. - + subroutine get_real_array4(this, var_name, var, ipermute, ld_first_touch) - use netcdf, only: NF90_MAX_VAR_DIMS, NF90_NOERR, nf90_get_var, nf90_strerror - class(netcdf_file) :: this character(len=*), intent(in) :: var_name real(jprb), allocatable, intent(out) :: var(:,:,:,:) @@ -2110,20 +1924,12 @@ subroutine get_real_array4(this, var_name, var, ipermute, ld_first_touch) if (ll_first_touch) then !!first touch - !$OMP parallel PRIVATE(ii,jj,kk,mm) + !$OMP PARALLEL DO PRIVATE(mm) do mm=1,ndimlen4 - !$OMP DO PRIVATE(ii,jj,kk) collapse(2) schedule(static) - do kk=1,ndimlen3 - do jj=1,ndimlen2 - !$omp simd - do ii=1,ndimlen1 - var(ii,jj,kk,mm) = 0.0_jprb - enddo - enddo - enddo - !$OMP END DO + ! array syntax in such a case lets the compiler use fast memset. REK. + var(:,:,:,mm) = 0.0_jprb end do - !$OMP END PARALLEL + !$OMP END PARALLEL DO end if istatus = nf90_get_var(this%ncid, ivarid, var) @@ -2141,9 +1947,6 @@ end subroutine get_real_array4 !--------------------------------------------------------------------- ! Get attribute as a character string subroutine get_string_attribute(this, var_name, attr_name, attr_str) - use netcdf, only: NF90_NOERR, nf90_get_att, & - & nf90_inquire_attribute, nf90_inq_varid, nf90_strerror - class(netcdf_file) :: this character(len=*), intent(in) :: var_name, attr_name @@ -2174,8 +1977,7 @@ subroutine get_string_attribute(this, var_name, attr_name, attr_str) ! end if ! allocate(character(len=i_attr_len) :: attr_str) if (len(attr_str) < i_attr_len) then - write(nulerr,'(a,a,a,i0,a,i0)') '*** Not enough space to read attribute ', attr_name, & - & ': ', i_attr_len, '>', len(attr_str) + write(nulerr,'(a,a)') '*** Not enough space to read attribute ', attr_name call my_abort('Error reading NetCDF file') end if @@ -2197,8 +1999,6 @@ end subroutine get_string_attribute !--------------------------------------------------------------------- ! Get attribute as a real scalar subroutine get_real_scalar_attribute(this, var_name, attr_name, attr) - use netcdf, only: NF90_NOERR, nf90_get_att, nf90_inq_varid, nf90_strerror - class(netcdf_file) :: this character(len=*), intent(in) :: var_name, attr_name @@ -2226,9 +2026,6 @@ end subroutine get_real_scalar_attribute !--------------------------------------------------------------------- ! Get a global attribute as a character string subroutine get_global_attribute(this, attr_name, attr_str) - use netcdf, only: NF90_NOERR, NF90_GLOBAL, & - & nf90_inquire_attribute, nf90_get_att, nf90_strerror - class(netcdf_file) :: this character(len=*), intent(in) :: attr_name @@ -2276,8 +2073,6 @@ end subroutine get_global_attribute ! Print a variable's long_name, units and comment, according to ! verbosity level subroutine print_variable_attributes(this, ivarid, iunit) - use netcdf, only: NF90_NOERR, nf90_get_att, nf90_strerror - class(netcdf_file) :: this integer, intent(in) :: ivarid ! NetCDF ID of variable integer, intent(in) :: iunit ! Unit to print information to @@ -2321,8 +2116,6 @@ end subroutine print_variable_attributes ! Define a dimension with name dim_name of length n (or 0 to ! indicate the unlimited dimension) subroutine define_dimension(this, dim_name, n) - use netcdf, only: NF90_NOERR, nf90_def_dim, nf90_strerror - class(netcdf_file) :: this character(len=*), intent(in) :: dim_name integer, intent(in) :: n @@ -2354,10 +2147,6 @@ subroutine define_variable(this, var_name, dim1_name, dim2_name, dim3_name, & & dim4_name, long_name, units_str, comment_str, & & standard_name, is_double, data_type_name, fill_value, & & deflate_level, shuffle, chunksizes, ndims) - use netcdf, only: NF90_MAX_VAR_DIMS, NF90_NOERR, NF90_DOUBLE, NF90_BYTE, NF90_SHORT, & - & NF90_INT, NF90_FLOAT, nf90_inq_dimid, nf90_strerror, nf90_def_var, & - & nf90_def_var_fill, nf90_put_att - class(netcdf_file) :: this character(len=*), intent(in) :: var_name character(len=*), intent(in), optional :: long_name, units_str, comment_str, standard_name @@ -2539,8 +2328,6 @@ end subroutine define_variable subroutine put_global_attributes(this, title_str, inst_str, source_str, & & comment_str, references_str, creator_name, creator_email_str, & & contributor_name, project_str, conventions_str, prior_history_str) - use netcdf, only: NF90_GLOBAL, nf90_put_att - class(netcdf_file) :: this character(len=*), intent(in), optional :: title_str @@ -2593,8 +2380,6 @@ end subroutine put_global_attributes !--------------------------------------------------------------------- ! Put a non-standard global attribute into the file subroutine put_global_attribute(this, attr_name, attr_str) - use netcdf, only: NF90_GLOBAL, NF90_NOERR, nf90_put_att, nf90_strerror - class(netcdf_file) :: this character(len=*), intent(in) :: attr_name, attr_str @@ -2615,8 +2400,6 @@ end subroutine put_global_attribute !--------------------------------------------------------------------- ! Put a non-standard variable attribute into the file subroutine put_attribute(this, var_name, attr_name, attr_str) - use netcdf, only: NF90_NOERR, nf90_put_att, nf90_strerror - class(netcdf_file) :: this character(len=*), intent(in) :: var_name, attr_name, attr_str @@ -2641,8 +2424,6 @@ end subroutine put_attribute ! variable with name var_name, according to the rank of the var ! argument. This version saves a scalar. subroutine put_real_scalar(this, var_name, var) - use netcdf, only: NF90_MAX_VAR_DIMS, NF90_NOERR, nf90_put_var, nf90_strerror - class(netcdf_file) :: this character(len=*), intent(in) :: var_name real(jprb), intent(in) :: var @@ -2677,8 +2458,6 @@ end subroutine put_real_scalar !--------------------------------------------------------------------- ! Save a scalar. subroutine put_real_scalar_indexed(this, var_name, index, var) - use netcdf, only: NF90_MAX_VAR_DIMS, NF90_NOERR, nf90_put_var, nf90_strerror - class(netcdf_file) :: this character(len=*), intent(in) :: var_name real(jprb), intent(in) :: var @@ -2716,8 +2495,6 @@ end subroutine put_real_scalar_indexed !--------------------------------------------------------------------- ! Save a vector with name var_name in the file subroutine put_real_vector(this, var_name, var) - use netcdf, only: NF90_MAX_VAR_DIMS, NF90_NOERR, nf90_put_var, nf90_strerror - class(netcdf_file) :: this character(len=*), intent(in) :: var_name real(jprb), intent(in) :: var(:) @@ -2751,8 +2528,6 @@ end subroutine put_real_vector !--------------------------------------------------------------------- ! Save an integer vector with name var_name in the file subroutine put_int_vector(this, var_name, var) - use netcdf, only: NF90_MAX_VAR_DIMS, NF90_NOERR, nf90_put_var, nf90_strerror - class(netcdf_file) :: this character(len=*), intent(in) :: var_name integer, intent(in) :: var(:) @@ -2786,8 +2561,6 @@ end subroutine put_int_vector !--------------------------------------------------------------------- ! Save a vector slice with name var_name in the file subroutine put_real_vector_indexed(this, var_name, var, index2, index3) - use netcdf, only: NF90_MAX_VAR_DIMS, NF90_NOERR, nf90_put_var, nf90_strerror - class(netcdf_file) :: this character(len=*), intent(in) :: var_name real(jprb), intent(in) :: var(:) @@ -2856,8 +2629,6 @@ end subroutine put_real_vector_indexed ! dimensions if either optional argument transp is .true., or the ! transpose_matrices method has already been called. subroutine put_real_matrix(this, var_name, var, do_transp) - use netcdf, only: NF90_MAX_VAR_DIMS, NF90_NOERR, nf90_put_var, nf90_strerror - class(netcdf_file) :: this character(len=*), intent(in) :: var_name real(jprb), intent(in) :: var(:,:) @@ -2923,8 +2694,6 @@ end subroutine put_real_matrix ! dimensions if either optional argument transp is .true., or the ! transpose_matrices method has already been called. subroutine put_real_matrix_indexed(this, var_name, var, index3, index4, do_transp) - use netcdf, only: NF90_MAX_VAR_DIMS, NF90_NOERR, nf90_put_var, nf90_strerror - class(netcdf_file) :: this character(len=*), intent(in) :: var_name real(jprb), intent(in) :: var(:,:) @@ -3019,8 +2788,6 @@ end subroutine put_real_matrix_indexed ! containing the size of each dimension in memory and in the written ! file, respectively, then NEW=OLD(ipermute). subroutine put_real_array3(this, var_name, var, ipermute) - use netcdf, only: NF90_MAX_VAR_DIMS, NF90_NOERR, nf90_put_var, nf90_strerror - class(netcdf_file) :: this character(len=*), intent(in) :: var_name real(jprb), intent(in) :: var(:,:,:) @@ -3102,8 +2869,6 @@ end subroutine put_real_array3 !--------------------------------------------------------------------- ! Copy dimensions from "infile" to "this" subroutine copy_dimensions(this, infile) - use netcdf, only: NF90_NOERR, nf90_inq_dimids, nf90_inquire_dimension, nf90_strerror - class(netcdf_file) :: this type(netcdf_file), intent(in) :: infile @@ -3114,7 +2879,7 @@ subroutine copy_dimensions(this, infile) character(len=512) :: dimname integer :: istatus integer :: include_parents - + include_parents = 0 istatus = nf90_inq_dimids(infile%ncid, ndims, idimids, include_parents) @@ -3141,11 +2906,6 @@ end subroutine copy_dimensions !--------------------------------------------------------------------- ! Copy variable definition and attributes from "infile" to "this" subroutine copy_variable_definition(this, infile, var_name) - use netcdf, only: NF90_MAX_VAR_DIMS, NF90_NOERR, & - & nf90_inq_varid, nf90_inquire_variable, & - & nf90_inq_dimid, nf90_inquire_dimension, & - & nf90_def_var, nf90_inq_attname, nf90_copy_att, nf90_strerror - class(netcdf_file) :: this type(netcdf_file), intent(in) :: infile character(len=*), intent(in) :: var_name @@ -3172,10 +2932,10 @@ subroutine copy_variable_definition(this, infile, var_name) end if ! Get variable ID from name - istatus = nf90_inq_varid(infile%ncid, trim(var_name), ivarid_in) + istatus = nf90_inq_varid(infile%ncid, var_name, ivarid_in) if (istatus /= NF90_NOERR) then - write(nulerr,'(a,a,a)') '*** Error inquiring about NetCDF variable "', & - & trim(var_name), '": ', trim(nf90_strerror(istatus)) + write(nulerr,'(a,i0,a)') '*** Error inquiring about NetCDF variable "', & + & var_name, '": ', trim(nf90_strerror(istatus)) call my_abort('Error reading NetCDF file') end if @@ -3243,9 +3003,6 @@ end subroutine copy_variable_definition !--------------------------------------------------------------------- ! Copy variable from "infile" to "this" subroutine copy_variable(this, infile, var_name) - use netcdf, only: NF90_MAX_VAR_DIMS, NF90_NOERR, NF90_DOUBLE, NF90_FLOAT, & - & nf90_inquire_variable, nf90_strerror - class(netcdf_file) :: this class(netcdf_file), intent(in) :: infile character(len=*), intent(in) :: var_name @@ -3253,7 +3010,7 @@ subroutine copy_variable(this, infile, var_name) integer :: ivarid_in, ivarid_out integer :: ndims integer :: ndimlens(NF90_MAX_VAR_DIMS) - integer(kind=jpib) :: ntotal, ntotal_out + integer(kind=jpib) :: ntotal integer :: data_type integer :: istatus @@ -3281,13 +3038,7 @@ subroutine copy_variable(this, infile, var_name) call my_abort('Error reading NetCDF file') end if - call this%get_variable_id(var_name, ivarid_out) - call this%get_array_dimensions(ivarid_out, ndims, ndimlens, ntotal_out) - if (ntotal /= ntotal_out) then - write(nulerr,'(a)') '*** Error: size mismatch between input and output variables' - call my_abort('Error writing NetCDF file') - end if - + call infile%get_variable_id(var_name, ivarid_out) if (data_type == NF90_DOUBLE .or. data_type == NF90_FLOAT) then allocate(data_real(ntotal)) !istatus = nf90_get_var(infile%ncid, ivarid_in, data_real(1)) @@ -3314,7 +3065,7 @@ subroutine copy_variable(this, infile, var_name) istatus = nf_get_var_int(infile%ncid, ivarid_in, data_int) if (istatus /= NF90_NOERR) then deallocate(data_int) - + write(nulerr,'(a,a,a,a)') '*** Error reading variable "', var_name, '": ', & & trim(nf90_strerror(istatus)) call my_abort('Error reading NetCDF file') diff --git a/utilities/easy_netcdf_read_mpi.F90 b/utilities/easy_netcdf_read_mpi.F90 index 309d8a73..aafbbec2 100644 --- a/utilities/easy_netcdf_read_mpi.F90 +++ b/utilities/easy_netcdf_read_mpi.F90 @@ -42,25 +42,19 @@ module easy_netcdf_read_mpi procedure :: get_real_vector procedure :: get_real_vector_active procedure :: get_int_vector - procedure :: get_integer_vector procedure :: get_real_matrix procedure :: get_real_matrix_active - procedure :: get_real_matrix_indexed - procedure :: get_real_matrix_indexed2 procedure :: get_real_array3 procedure :: get_real_array3_active procedure :: get_real_array3_indexed procedure :: get_real_array3_indexed2 procedure :: get_real_array4 procedure :: get_real_array4_active - procedure :: get_char_vector - procedure :: get_char_matrix generic :: get => get_real_scalar, get_int_scalar, & & get_real_vector, get_int_vector, & - & get_real_matrix, get_real_matrix_indexed, get_real_array3, & + & get_real_matrix, get_real_array3, & & get_real_array4, get_real_array3_indexed, & - & get_real_matrix_indexed2, get_real_array3_indexed2, & - & get_char_vector, get_char_matrix + & get_real_array3_indexed2 generic :: get_active => get_real_vector_active, get_real_matrix_active, & & get_real_array3_active, get_real_array4_active procedure :: get_global_attribute @@ -416,43 +410,6 @@ subroutine get_int_vector(this, var_name, vector) end subroutine get_int_vector - !--------------------------------------------------------------------- - ! Read a 1D JPIM-kind integer array into "vector", which must be allocatable - ! and will be reallocated if necessary - - subroutine get_integer_vector(this, var_name, vector) - - USE MPL_MODULE, ONLY : MPL_BROADCAST, MPL_NPROC - - class(netcdf_file) :: this - character(len=*), intent(in) :: var_name - integer(jpim), allocatable, intent(out) :: vector(:) - - integer :: n ! Length of vector - - n = 0 - - if (this%is_master_task) then - call this%file%get(var_name, vector) - n = size(vector) - end if - - if (MPL_NPROC() > 1) then - CALL MPL_BROADCAST(n, mtagrad, 1, & - & CDSTRING='EASY_NETCDF_READ_MPI:GET_INT_VECTOR:SIZE') - - if (.not. this%is_master_task) then - if (allocated(vector)) deallocate(vector) - allocate(vector(n)) - end if - - CALL MPL_BROADCAST(vector, mtagrad, 1, & - & CDSTRING='EASY_NETCDF_READ_MPI:GET_INT_VECTOR') - end if - - end subroutine get_integer_vector - - !--------------------------------------------------------------------- ! Read 2D array into "matrix", which must be allocatable and will be @@ -495,87 +452,6 @@ subroutine get_real_matrix(this, var_name, matrix, do_transp) end subroutine get_real_matrix - - !--------------------------------------------------------------------- - ! Read 2D array into "matrix", which must be allocatable and will be - ! reallocated if necessary. Whether to transpose is specifed by the - ! final optional argument, but can also be specified by the - ! do_transpose_2d class data member. - subroutine get_real_matrix_indexed(this, var_name, matrix, index, do_transp) - - USE MPL_MODULE, ONLY : MPL_BROADCAST, MPL_NPROC - - class(netcdf_file) :: this - character(len=*), intent(in) :: var_name - real(jprb), allocatable, intent(out) :: matrix(:,:) - integer, intent(in) :: index - logical, optional, intent(in):: do_transp ! Transpose data? - - integer :: n(2) - - n = 0 - - if (this%is_master_task) then - call this%file%get(var_name, matrix, index, do_transp) - n = shape(matrix) - end if - - if (MPL_NPROC() > 1) then - CALL MPL_BROADCAST(n, mtagrad, 1, & - & CDSTRING='EASY_NETCDF_READ_MPI:GET_REAL_MATRIX_INDEXED:SIZE') - - if (.not. this%is_master_task) then - if(allocated(matrix))deallocate(matrix) - allocate(matrix(n(1),n(2))) - end if - - CALL MPL_BROADCAST(matrix, mtagrad, 1, & - & CDSTRING='EASY_NETCDF_READ_MPI:GET_REAL_MATRIX_INDEXED') - end if - - end subroutine get_real_matrix_indexed - - - !--------------------------------------------------------------------- - ! Read 2D array into "matrix", which must be allocatable and will be - ! reallocated if necessary. Whether to transpose is specifed by the - ! final optional argument, but can also be specified by the - ! do_transpose_2d class data member. - subroutine get_real_matrix_indexed2(this, var_name, matrix, index3, index4, do_transp) - - USE MPL_MODULE, ONLY : MPL_BROADCAST, MPL_NPROC - - class(netcdf_file) :: this - character(len=*), intent(in) :: var_name - real(jprb), allocatable, intent(out) :: matrix(:,:) - integer, intent(in) :: index3, index4 - logical, optional, intent(in):: do_transp ! Transpose data? - - integer :: n(2) - - n = 0 - - if (this%is_master_task) then - call this%file%get(var_name, matrix, index3, index4, do_transp) - n = shape(matrix) - end if - - if (MPL_NPROC() > 1) then - CALL MPL_BROADCAST(n, mtagrad, 1, & - & CDSTRING='EASY_NETCDF_READ_MPI:GET_REAL_MATRIX_INDEXED2:SIZE') - - if (.not. this%is_master_task) then - if (allocated(matrix)) deallocate(matrix) - allocate(matrix(n(1),n(2))) - end if - - CALL MPL_BROADCAST(matrix, mtagrad, 1, & - & CDSTRING='EASY_NETCDF_READ_MPI:GET_REAL_MATRIX_INDEXED2') - end if - - end subroutine get_real_matrix_indexed2 - - ! version with active rank specified ! irequest : for non_blocking broadcasts, the message handle that will have to be waited on ! imp_type : choose between JP_(BLOCKING/NON-BLOCKING)_(STANDARD/BUFFERED) @@ -859,88 +735,6 @@ subroutine get_real_array4_active(this, var_name, var, iactive_rank, ipermute, i end subroutine get_real_array4_active - !--------------------------------------------------------------------- - ! Read a 1D character array into "vector", which must be allocatable - ! and will be reallocated if necessary - subroutine get_char_vector(this, var_name, vector) - - USE MPL_MODULE, ONLY : MPL_BROADCAST, MPL_NPROC - - class(netcdf_file) :: this - character(len=*), intent(in) :: var_name - character(len=1), allocatable, intent(out) :: vector(:) - - integer :: n - - !! these two if statements have to be nested, because MPL_NPROC() crashes if mpi is not initialized - if (this%is_master_task) then - call this%file%get(var_name, vector) - n = size(vector) - end if - if (this%mpi_enabled) then - if (MPL_NPROC() > 1) then - CALL MPL_BROADCAST(n, mtagrad, 1, & - & CDSTRING='EASY_NETCDF_READ_MPI:GET_CHAR_VECTOR:SIZE') - - if (.not. this%is_master_task) then - if(allocated(vector))deallocate(vector) - allocate(vector(n)) - end if - - CALL MPL_BROADCAST(vector, mtagrad, 1, & - & CDSTRING='EASY_NETCDF_READ_MPI:GET_CHAR_VECTOR') - end if - end if - - end subroutine get_char_vector - - - !--------------------------------------------------------------------- - ! Read 2D array of characters into "matrix", which must be - ! allocatable and will be reallocated if necessary. Whether to - ! transpose is specifed by the final optional argument, but can also - ! be specified by the do_transpose_2d class data member. - subroutine get_char_matrix(this, var_name, matrix, do_transp) - - USE MPL_MODULE, ONLY : MPL_BROADCAST, MPL_NPROC - - class(netcdf_file) :: this - character(len=*), intent(in) :: var_name - character(len=1), allocatable, intent(inout) :: matrix(:,:) - logical, optional, intent(in):: do_transp ! Transpose data? - - integer :: n(2) - integer :: j - - n = 0 - - if (this%is_master_task) then - call this%file%get(var_name, matrix, do_transp) - n = shape(matrix) - end if - - !! these two if statements have to be nested, because MPL_NPROC() crashes if mpi is not initialized - if (this%mpi_enabled) then - if (MPL_NPROC() > 1) then - CALL MPL_BROADCAST(n, mtagrad, 1, & - & CDSTRING='EASY_NETCDF_READ_MPI:GET_CHAR_MATRIX:SIZE') - - if (.not. this%is_master_task) then - if(allocated(matrix))deallocate(matrix) - allocate(matrix(n(1),n(2))) - end if - - ! MPL has no char2 broadcast - do j = 1, n(2) - CALL MPL_BROADCAST(matrix(:,j), mtagrad, 1, & - & CDSTRING='EASY_NETCDF_READ_MPI:GET_CHAR_MATRIX') - end do - end if - end if - - end subroutine get_char_matrix - - !--------------------------------------------------------------------- ! Get a global attribute as a character string subroutine get_global_attribute(this, attr_name, attr_str) diff --git a/utilities/radiation_io.F90 b/utilities/radiation_io.F90 index 12d03e13..1e035c7f 100644 --- a/utilities/radiation_io.F90 +++ b/utilities/radiation_io.F90 @@ -11,6 +11,7 @@ ! ! Author: Robin Hogan ! Email: r.j.hogan@ecmwf.int +! License: see the COPYING file for details ! ! This file provides an interface to the provision of file units used ! for logging (nulout and nulerr) and for reading data files @@ -32,10 +33,13 @@ module radiation_io use yomlun_ecrad, only : nulout, nulerr implicit none - public ! This unit may be used for reading radiation configuration files, - ! but should be closed as soon as the file is read + ! but should be closed as soon as the file is read. Note that we + ! cannot read the value with the same name from + ! ifs/module/yomlun.F90 since that module is compiled after this + ! one. When the Fortran 2008 standard is more widely supported, the + ! NEWUNIT feature of OPEN could be used instead integer :: nulrad = 25 contains @@ -45,7 +49,6 @@ module radiation_io subroutine radiation_abort(text) character(len=*), intent(in), optional :: text -#ifdef HAVE_FIAT #include "abor1.intfb.h" if (present(text)) then @@ -53,23 +56,6 @@ subroutine radiation_abort(text) else call abor1('Error in radiation scheme') end if -#else - - if (present(text)) then - write(nulerr,'(a)') text -#ifdef __PGI - stop 1 -#else - error stop 1 -#endif - else -#ifdef __PGI - stop 'Error in radiation scheme' -#else - error stop 'Error in radiation scheme' -#endif - end if -#endif /* HAVE_FIAT */ end subroutine radiation_abort end module radiation_io From d9609fdd183c2e6edc678897140c992841066e80 Mon Sep 17 00:00:00 2001 From: Philippe Marguinaud Date: Tue, 12 May 2026 12:27:18 +0000 Subject: [PATCH 5/5] Fix -DFortran_FLAGS not taken into account by ecbuild --- CMakeLists.txt | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 58a43319..7fedab9a 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -33,9 +33,10 @@ endif() # ... before doing a final find_package to make it available. find_package( ecbuild ${MINIMUM_ECBUILD_VERSION} REQUIRED ) -# We set the _ECBUILD_COMPILE_FLAGS variable to an empty file. This ensures that we can -# specify a default set of compilation flags as well as per-file overwrites as part of the CMake config. -set( ECRAD_ECBUILD_COMPILE_FLAGS ${CMAKE_CURRENT_SOURCE_DIR}/cmake/ecrad_init_flags.cmake CACHE FILEPATH "") +#### The following lines purges compiler flags, which erases options passed into -DFortran_FLAGS=... +#### # We set the _ECBUILD_COMPILE_FLAGS variable to an empty file. This ensures that we can +#### # specify a default set of compilation flags as well as per-file overwrites as part of the CMake config. +#### set( ECRAD_ECBUILD_COMPILE_FLAGS ${CMAKE_CURRENT_SOURCE_DIR}/cmake/ecrad_init_flags.cmake CACHE FILEPATH "") project( ecrad LANGUAGES Fortran ) ecbuild_enable_fortran( REQUIRED )