From 303eb9e4172640b4d12a7a792b03340df8f60073 Mon Sep 17 00:00:00 2001
From: Jean-Pierre CHABOUREAU <jean-pierre.chaboureau@aero.obs-mip.fr>
Date: Fri, 22 Dec 2023 16:06:15 +0100
Subject: [PATCH] Jean-Pierre 21/12/2023: remove CRAD_SAT and old RTTOV
versions
---
A-INSTALL | 63 +-
src/MNH/call_rttov11.f90 | 619 -------
src/MNH/call_rttov13.f90 | 6 +-
src/MNH/call_rttov8.f90 | 1806 -------------------
src/MNH/diag.f90 | 7 +-
src/MNH/modd_diag_flag.f90 | 1 -
src/MNH/nband_model.fx90 | 2286 ------------------------
src/MNH/reset_exseg.f90 | 3 -
src/MNH/write_lfifm1_for_diag_supp.f90 | 99 +-
src/Makefile.MESONH.mk | 25 +-
src/PHYEX/micro/radtr_satel.f90 | 756 --------
11 files changed, 12 insertions(+), 5659 deletions(-)
delete mode 100644 src/MNH/call_rttov11.f90
delete mode 100644 src/MNH/call_rttov8.f90
delete mode 100644 src/MNH/nband_model.fx90
delete mode 100644 src/PHYEX/micro/radtr_satel.f90
diff --git a/A-INSTALL b/A-INSTALL
index b24b68d83..2e143449f 100644
--- a/A-INSTALL
+++ b/A-INSTALL
@@ -1022,13 +1022,9 @@ git clone -b 2014.01 https://github.com/forefireAPI/firefront.git
# b) MNH_RTTOV for optional radiative computation
# --------------------------------------
#
-# The RTTOV package was not included into the open source version of Meso-NH
+# The RTTOV 13.2 package was not included into the open source version of Meso-NH
# because it needs a licence agrement.
#
-# ----------------------------------
-# OPTION 1: Use version 13.2 of RTTOV
-# -----------------------------------
-#
# Run the 'configure' script preceded with the setting of the MNH_RTTOV variable:
#
cd MNH.../src/
@@ -1058,63 +1054,6 @@ make ARCH=ifort # Use Intel "ifort" compiler; other options: gfortran, NA
cd MNH.../src/
make
-# ----------------------------------
-# OPTION 2: Use version 11.3 of RTTOV
-# -----------------------------------
-# Download the RTTOV package rttov113.tar.gz by following the instructions given on https://nwpsaf.eu/site/software/rttov/
-#
-# Install the RTTOV package rttov113.tar.gz
-cd MNH.../src/LIB
-mkdir RTTOV-11.3
-cd RTTOV-11.3
-tar xvfz rttov113.tar.gz
-cd src
-make ARCH=ifort # Use Intel "ifort" compiler; other options: gfortran, NAG, pgf90, IBM
-#
-# And then for the compilation, run the 'configure' script preceded with the setting of the MNH_RTTOV variable:
-#
-
-cd MNH.../src/
-export MNH_RTTOV=1
-export VER_RTTOV=11.3
-./configure
-
-etc ...
-
-# ----------------------------------
-# OPTION 3: Use version 8.7 of RTTOV
-# ----------------------------------
-# For already(old) licencied MesoNH users (MNH-4-X version with research licence see here: http://mesonh.aero.obs-mip.fr/mesonh410/UserInformation)
-#
-# the package could be reloaded in this way
-#
-# - With cvs access
-#
-
-cd MNH.../src/LIB
-cvs up -rPACK-MNH-V4-10-3 -d -P RTTOV
-
-#
-# - With WEB access (with WEB login/pass as usually) the RTTOV package could also be retrieve in tarball with wget like this:
-#
-
-cd MNH.../src/LIB
-wget --http-user=USER --http-password=PASS 'http://mesonh.aero.obs-mip.fr/cgi-bin/mesonh_interne/viewcvs.cgi/MNH-VX-Y-Z/src/LIB/RTTOV/?view=tar&pathrev=PACK-MNH-V4-10-3' -O RTTOV.tar.gz
-tar xvfz RTTOV.tar.gz
-
-# /!\ don't forget the ''. Otherwise, this will not work!
-
-#
-# And then for the compilation, run the 'configure' script preceded with the setting of the MNH_RTTOV variable:
-#
-
-cd MNH.../src/
-export MNH_RTTOV=1
-export VER_RTTOV=8.7
-./configure
-
-etc ...
-
# c) MNH_ECRAD for optional compilation of new ECRAD radiative library from ECMWF
# --------------------------------------
#
diff --git a/src/MNH/call_rttov11.f90 b/src/MNH/call_rttov11.f90
deleted file mode 100644
index c949ca4eb..000000000
--- a/src/MNH/call_rttov11.f90
+++ /dev/null
@@ -1,619 +0,0 @@
-!MNH_LIC Copyright 2003-2021 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ########################
- MODULE MODI_CALL_RTTOV11
-! ########################
-INTERFACE
-!
- SUBROUTINE CALL_RTTOV11(KDLON, KFLEV, PEMIS, PTSRAD, &
- PTHT, PRT, PPABST, PZZ, PMFCONV, PCLDFR, PULVLKB, PVLVLKB, &
- OUSERI, KRTTOVINFO, TPFILE )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KDLON !number of columns where the
- !radiation calculations are performed
-INTEGER, INTENT(IN) :: KFLEV !number of vertical levels where the
- !radiation calculations are performed
-!
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PEMIS !Surface IR EMISsivity
-REAL, DIMENSION(:,:), INTENT(IN) :: PTSRAD !RADiative Surface Temperature
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT !THeta at t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT !moist variables at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST !pressure at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ !Model level heights
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV! convective mass flux (kg /s m^2)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! cloud fraction
-REAL, DIMENSION(:,:), INTENT(IN) :: PULVLKB ! U-wind at KB level
-REAL, DIMENSION(:,:), INTENT(IN) :: PVLVLKB ! V-wind at KB level
-!
-LOGICAL, INTENT(IN) :: OUSERI ! logical switch to compute both
- ! liquid and solid condensate (OUSERI=.TRUE.)
- ! or only liquid condensate (OUSERI=.FALSE.)
-!
-INTEGER, DIMENSION(:,:), INTENT(IN) :: KRTTOVINFO ! platform, satelit, sensor,
- ! and selection calculations
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File characteristics
-!
-END SUBROUTINE CALL_RTTOV11
-END INTERFACE
-END MODULE MODI_CALL_RTTOV11
-! #####################################################################
-SUBROUTINE CALL_RTTOV11(KDLON, KFLEV, PEMIS, PTSRAD, &
- PTHT, PRT, PPABST, PZZ, PMFCONV, PCLDFR, PULVLKB, PVLVLKB, &
- OUSERI, KRTTOVINFO, TPFILE )
-! #####################################################################
-!!
-!!**** *CALL_RTTOV* -
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!! See Chaboureau and Pinty, 2006
-!! Validation of a cirrus parameterization with Meteosat Second Generation
-!! observations. Geophys. Res. Let., doi:10.1029/2005GL024725
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Chaboureau *L.A.*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 11/12/03
-!! JP Chaboureau 27/03/2008 Vectorization
-!! JP Chaboureau 02/11/2009 move GANGL deallocation outside the sensor loop
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! JP Chaboureau 30/05/2017 exclude the first layer when considering clouds
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-! JP Chaboureau 26/10/2020: calculate all IR intruments; deallocate MW tabs
-!!----------------------------------------------------------------------------
-!!
-!!* 0. DECLARATIONS
-!! ------------
-!!
-USE MODD_CST
-USE MODD_PARAMETERS
-USE MODD_GRID_n
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_FIELD, ONLY: TFIELDMETADATA, TYPEREAL
-USE MODD_LUNIT_n
-USE MODD_DEEP_CONVECTION_n
-USE MODD_REF_n
-USE MODD_RADIATIONS_n, ONLY : XSEA
-!
-USE MODN_CONF
-!
-USE MODI_DETER_ANGLE
-USE MODI_PINTER
-!
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
-USE MODE_ll
-USE MODE_MSG
-USE MODE_POS
-!
-#ifdef MNH_RTTOV_11
-USE rttov_const, ONLY : &
- & sensor_id, sensor_id_ir, sensor_id_hi, sensor_id_mw, &
- & q_mixratio_to_ppmv, tmin, tmax, qmin, qmax, pmin, pmax
-USE rttov_types
-USE parkind1, ONLY: jpim, jprb, jplm
-!
-IMPLICIT NONE
-!
-! -----------------------------------------------------------------------------
-#include "rttov_direct.interface"
-#include "rttov_read_coefs.interface"
-#include "rttov_alloc_transmission.interface"
-#include "rttov_dealloc_coefs.interface"
-#include "rttov_read_scattcoeffs.interface"
-#include "rttov_dealloc_scattcoeffs.interface"
-#include "rttov_scatt_setupindex.interface"
-#include "rttov_scatt.interface"
-#include "rttov_scatt_ad.interface"
-#include "rttov_alloc_rad.interface"
-#include "rttov_init_rad.interface"
-#include "rttov_alloc_prof.interface"
-#include "rttov_alloc_scatt_prof.interface"
-#endif
-!!!
-!!!* 0.1 DECLARATIONS OF DUMMY ARGUMENTS :
-!!!
-INTEGER, INTENT(IN) :: KDLON !number of columns where the
-! radiation calculations are performed
-INTEGER, INTENT(IN) :: KFLEV !number of vertical levels where the
-! radiation calculations are performed
-!!!
-REAL, DIMENSION(:,:), INTENT(IN) :: PEMIS !Surface IR EMISsivity
-REAL, DIMENSION(:,:), INTENT(IN) :: PTSRAD !RADiative Surface Temperature
- !
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT !THeta at t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT !moist variables at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST !pressure at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ !Model level heights
-!!!
-!!!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV! convective mass flux (kg /s m^2)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! cloud fraction
-REAL, DIMENSION(:,:), INTENT(IN) :: PULVLKB ! U-wind at KB level
-REAL, DIMENSION(:,:), INTENT(IN) :: PVLVLKB ! V-wind at KB level
-!!!
-LOGICAL, INTENT(IN) :: OUSERI ! logical switch to compute both
-! liquid and solid condensate (OUSERI=.TRUE.)
-! or only liquid condensate (OUSERI=.FALSE.)
-!!!
-INTEGER, DIMENSION(:,:), INTENT(IN) :: KRTTOVINFO ! platform, satelit, sensor,
- ! and selection calculations
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File characteristics
-!
-#ifdef MNH_RTTOV_11
-!!!
-!!!* 0.2 DECLARATIONS OF LOCAL VARIABLES
-!!!
-!!!
-INTEGER, PARAMETER :: JPNSAT=3 ! No. of Satellite required
- !
-INTEGER :: JI,JJ,JK,JK1,JK2,JKRAD,JKF,JSAT,JC ! loop indexes
- !
-INTEGER :: IJSAT ! number of columns/=NUNDEF which
- ! have to be treated in the table KRTTOVINFO(:,:)
-INTEGER :: IIB,IIE ! I index value of the first/last inner mass point
-INTEGER :: IJB,IJE ! J index value of the first/last inner mass point
-INTEGER :: IKB,IKE ! K index value of the first/last inner mass point
-INTEGER :: IIU ! array size for the first index
-INTEGER :: IJU ! array size for the second index
-INTEGER :: IKU ! array size for the third index
-INTEGER :: IKR ! real array size for the third index
-INTEGER (Kind=jpim) :: iwp_levels ! equal to IKR (call to rttov_scatt)
-INTEGER :: IIJ ! reformatted array index
-INTEGER :: IKSTAE ! level number of the STAndard atmosphere array
-INTEGER :: IKUP ! vertical level above which STAndard atmosphere data
-
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZBT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZANTMP, ZUTH
-REAL :: ZZH, zdeg_to_rad, zrad_to_deg, zbeta, zalpha
-
-! Other arrays for zenithal solar angle
-! REAL, DIMENSION(:,:), ALLOCATABLE :: ZCOSZEN, ZSINZEN, ZAZIMSOL
-
-! -----------------------------------------------------------------------------
-REAL, DIMENSION(1) :: ZANGL, ZLON, ZLAT !Satellite zenith angle, longitude, latitude (deg)
-REAL :: ZANGS !Solar zenith angle (deg)
-! -----------------------------------------------------------------------------
-! INDEXES AND TEMPORAL ARRAYS FOR VECTORIZATION
-INTEGER :: JIS, IBEG, IEND, IDIM, ICPT
-INTEGER, DIMENSION(:), ALLOCATABLE :: IMSURFP
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZAVP, ZCVP
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZSAVP, ZSSVP, ZAPP, ZAP_HLP
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZZTMP, ZZTMPP
-REAL, DIMENSION(:), ALLOCATABLE :: ZANGLP, ZREMISP
-LOGICAL, DIMENSION(:), ALLOCATABLE :: GANGL
-! -----------------------------------------------------------------------------
-INTEGER :: INRAD = 2 ! INRAD=1 RADIANCE; INRAD=2 BRIGHTNESS TEMPERATURE
-! -----------------------------------------------------------------------------
-! Realistic maximum values for hydrometeor content in kg/kg
-REAL :: ZRCMAX = 5.0E-03, ZRRMAX = 5.0E-03, ZRIMAX = 2.0E-03, ZRSMAX = 5.0E-03
-! -----------------------------------------------------------------------------
-INTEGER, DIMENSION(:), ALLOCATABLE :: IMSURF !Surface type index
-
-INTEGER :: IKFBOT, IKFTOP, INDEX, ISUM, JLEV, JCH, IWATER, ICAN
-REAL, DIMENSION(:), ALLOCATABLE :: ZTEXTR, ZQVEXTR !Array used in interpolation
-REAL, DIMENSION(:), ALLOCATABLE :: ZQVSAT, ZVINT !Array used in interpolation
-REAL, DIMENSION(:), ALLOCATABLE :: ZPSUM, ZTSUM, ZQVSUM, ZO3SUM !Array used in interpolation
-REAL :: zconst, ZPS, ZTGRAD, ZQGRAD, ZOGRAD !variables used in interpolation
-REAL, DIMENSION(:), ALLOCATABLE :: ZPIN, ZFIN, ZOUT
-! at the open of the file LFI routines
-CHARACTER(LEN=8) :: YINST
-CHARACTER(LEN=4) :: YBEG, YEND
-CHARACTER(LEN=2) :: YCHAN, YTWO
-CHARACTER(LEN=1) :: YONE
-
-INTEGER, PARAMETER :: JPPLAT=16
-
-CHARACTER(LEN=3), DIMENSION(JPPLAT) :: YPLAT= (/ &
- 'N ','D ','MET','GO ','GMS','FY2','TRM','ERS', &
- 'EOS','MTP','ENV','MSG','FY1','ADS','MTS','CRL' /)
-CHARACTER(LEN=2), DIMENSION(2) :: YLBL_MVIRI = (/ 'WV', 'IR'/)
-CHARACTER(LEN=3), DIMENSION(7) :: YLBL_SSMI = (/ &
- '19V','19H','22V','37V','37H','85V','85H'/)
-CHARACTER(LEN=3), DIMENSION(9) :: YLBL_TMI = (/ &
- '10V','10H','19V','19H','22V','37V','37H','85V','85H'/)
-CHARACTER(LEN=3), DIMENSION(8) :: YLBL_SEVIRI = (/ &
- '039', '062','073','087','097','108','120','134'/)
-CHARACTER(LEN=3), DIMENSION(4) :: YLBL_GOESI = (/ &
- '039', '067','107','120'/)
-
-! -----------------------------------------------------------------------------
-LOGICAL (kind=jplm) , ALLOCATABLE :: calcemis (:)
-INTEGER (kind=jpim) , ALLOCATABLE :: frequencies (:)
-TYPE (rttov_chanprof) , ALLOCATABLE :: chanprof (:) ! Channel and profile indices
-TYPE (profile_type) , ALLOCATABLE :: profiles (:), profiles_k (:)
-TYPE (profile_cloud_type) , ALLOCATABLE :: cld_profiles(:), cld_profiles_k(:)
-TYPE(rttov_emissivity), ALLOCATABLE :: emissivity(:) ! Input/output surface emissivity
-LOGICAL(KIND=jplm), ALLOCATABLE :: calcrefl(:) ! Flag to indicate calculation of BRDF within RTTOV
-TYPE(rttov_reflectance), ALLOCATABLE :: reflectance(:) ! Input/output surface BRDF
- TYPE(transmission_type) :: transmission ! Output transmittances
- INTEGER(KIND=jpim) :: asw
-
-integer (kind=jpim) :: errorstatus
-type (radiance_type) :: radiance, radiance_k
-type (rttov_options) :: opts ! Defaults to everything optional switched off
-type (rttov_options_scatt) :: opts_scatt
-type (rttov_coefs ) :: coef_rttov
-type (rttov_scatt_coef) :: coef_scatt
-
-integer (kind=jpim) :: instrument (3)
-integer (kind=jpim) :: ilev, iprof, ichan, nprof, nchan, nlev, nchannels
-real (kind=jprb) :: zenangle
-integer (kind=jpim), parameter :: fin = 10
-character (len=256) :: outstring
-! -----------------------------------------------------------------------------
-REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZTEMP
-TYPE(TFIELDMETADATA) :: TZFIELD
-!-------------------------------------------------------------------------------
-!
-!* 0. ARRAYS BOUNDS INITIALIZATION
-!
-IIU=SIZE(PTHT,1)
-IJU=SIZE(PTHT,2)
-IKU=SIZE(PTHT,3)
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-IKB=1+JPVEXT
-IKE=IKU-JPVEXT
-
-errorstatus = 0
-nlev=IKE-IKB+1
-nprof=1
-ZTEMP = PTHT * ( PPABST/XP00 ) ** (XRD/XCPD)
-DO JSAT=1,SIZE(KRTTOVINFO,2)
- IF (KRTTOVINFO(1,JSAT) /= NUNDEF) THEN
- IJSAT = JSAT
- END IF
-END DO
-
-! -----------------------------------------------------------------------------
-! *** LOOP OVER SENSORS ***
-! -----------------------------------------------------------------------------
-DO JSAT=1,IJSAT ! loop over sensors
-
- instrument(1)=KRTTOVINFO(1,JSAT)
- instrument(2)=KRTTOVINFO(2,JSAT)
- instrument(3)=KRTTOVINFO(3,JSAT)
-! PRINT *,' JSAT=',JSAT, instrument
-
- IF( sensor_id( instrument(3) ) /= sensor_id_mw) THEN
- opts % rt_ir % addsolar = .FALSE. ! Do not include solar radiation
- opts % interpolation % addinterp = .TRUE. ! Allow interpolation of input profile
- opts % interpolation % interp_mode = 1 ! Set interpolation method
- opts % rt_all % addrefrac = .FALSE. ! Do not include refraction in path calc
- opts % rt_ir % addclouds = .TRUE. ! Include cloud effects
- opts % rt_ir % addaerosl = .FALSE. ! Don't include aerosol effects
- opts % rt_ir % ozone_data = .FALSE. ! Set the relevant flag to .TRUE.
- opts % rt_ir % co2_data = .FALSE. ! when supplying a profile of the
- opts % rt_ir % n2o_data = .FALSE. ! given trace gas (ensure the
- opts % rt_ir % ch4_data = .FALSE. ! coef file supports the gas)
- opts % rt_ir % co_data = .FALSE. !
-! opts % rt_mw % clw_data = .FALSE. !
-! opts%rt_ir%user_cld_opt_param = .FALSE.
- ELSE
- opts % rt_ir % addclouds = .FALSE. ! Include cloud effects
- END IF
- opts % config % verbose = .FALSE. ! Enable printing of warnings
- opts % config % do_checkinput = .FALSE.
-
-
-! Read and initialise coefficients
-! -----------------------------------------------------------------------------
- CALL rttov_read_coefs (errorstatus, coef_rttov, opts, instrument=instrument)
- IF(errorstatus /= 0) THEN
- WRITE(*,*) 'error rttov_readcoeffs :',errorstatus
- CALL PRINT_MSG(NVERB_FATAL,'GEN','CALL_RTTOV11','error rttov_readcoeffs')
- ENDIF
-! CALL rttov_initcoeffs (errorstatus,coef_rttov)
-! IF( errorstatus/= 0) THEN
-! WRITE(*,*) 'error rttov_initcoeffs :',errorstatus
-! CALL PRINT_MSG(NVERB_FATAL,'GEN','CALL_RTTOV11','error rttov_initcoeffs')
-! ENDIF
-
-! Read coef file for cloud/rain absorption/scattering
- IF( coef_rttov%coef%id_sensor == sensor_id_mw) THEN
- CALL rttov_read_scattcoeffs (errorstatus, coef_rttov%coef, coef_scatt)
- END IF
-
- nchan = coef_rttov%coef%fmv_chn ! number of channels on instrument
- nchannels = nprof * nchan ! total channels to simulate
-
- ALLOCATE(ZBT(IIU,IJU,nchannels))
- ZBT(:,:,:)=999.
-! PRINT *,'ncan=',nchan,' nchannels=',nchannels
-
- ALLOCATE (chanprof (nchannels))
- ALLOCATE (frequencies (nchannels))
- ALLOCATE (emissivity (nchannels))
- ALLOCATE (calcemis (nchannels))
- ALLOCATE (profiles (nprof))
- ALLOCATE (cld_profiles (nprof))
-! Request RTTOV / FASTEM to calculate surface emissivity
- calcemis = .TRUE.
- emissivity % emis_in = 0.0_JPRB
-
- IF( coef_rttov%coef% id_sensor /= sensor_id_mw) calcemis = .FALSE.
-
-! IF( coef_rttov%coef% id_sensor /= sensor_id_mw) THEN
-! ! Allocate arrays for surface reflectance
-! ALLOCATE(calcrefl(nchannels))
-! ALLOCATE(reflectance(nchannels))
-! END IF
-
-! Setup indices
- IF( coef_rttov%coef% id_sensor /= sensor_id_mw) THEN
- DO JCH=1,nchannels
- chanprof(JCH)%prof = 1
- chanprof(JCH)%chan = JCH
- END DO
- ELSE
- CALL rttov_scatt_setupindex ( &
- & nprof, & ! in
- & nchan, & ! in
- & coef_rttov%coef, & ! in
- & nchannels, & ! in
- & chanprof, & ! out
- & frequencies) ! out
- END IF
-
- asw = 1_jpim ! Switch for allocation passed into RTTOV subroutines
-
-! Allocate profiles (input) and radiance (output) structures
- CALL rttov_alloc_prof(errorstatus, nprof, profiles, nlev, opts,asw,coef_rttov,init = .TRUE._jplm)
- IF( coef_rttov%coef% id_sensor == sensor_id_mw) THEN
-! CALL rttov_alloc_opt_param( &
-! & errorstatus, &
-! & cld_opt_param, &
-! & nchanprof, &
-! & nlevels-1_jpim, &
-! & nphangle, &
-! & asw)
-! ELSE
- CALL rttov_alloc_scatt_prof( nprof, cld_profiles, nlev, .FALSE._jplm, 1_jpim, init = .TRUE._jplm)
- END IF
-
- CALL rttov_alloc_rad (errorstatus, nchannels, radiance, nlev-1_jpim,asw)
-! WRITE(*,*) 'error rttov_alloc_rad :',errorstatus
- ! Allocate transmittance structure
- CALL rttov_alloc_transmission( &
- & errorstatus, &
- & transmission, &
- & nlev-1_jpim, &
- & nchannels, &
- & asw, &
- & init=.TRUE.)
-
- profiles(1) % zenangle = 0. ! zenith
- cld_profiles(1) % use_totalice = .FALSE.
- profiles(1) % skin % fastem(:) = &
-! RTTOV 8.5 example
-! (/ 3.0_JPRB, 5.0_JPRB, 15.0_JPRB, 0.1_JPRB, 0.3_JPRB /)
-! Bare soil see Table 3 svr rttov7)
- (/ 2.3_JPRB, 1.9_JPRB, 21.8_JPRB, 0.0_JPRB, 0.5_JPRB /)
-
- profiles(1) % nlevels = nlev
- profiles(1) % nlayers = nlev-1
-
- ! Ensure the options and coefficients are consistent
- CALL rttov_user_options_checkinput(errorstatus, opts, coef_rttov)
- IF (errorstatus /= 0) THEN
- call Print_msg( NVERB_FATAL, 'GEN', 'CALL_RTTOV11', 'error in rttov options' )
- ENDIF
-
-!! opts%interpolation%reg_limit_extrap = .TRUE.
-!! profiles(1)%gas_units = 1 ! kg/kg over moist air
-! PRINT *,'nlev=',nlev,' tmax=',tmax,' tmin=',tmin,' qmax=',qmax,' qmin=',qmin
-! PRINT *, coef_rttov%coef % nlevels
- DO JI=IIB,IIE
- DO JJ=IJB,IJE
- ZANGL = XUNDEF
- ZLON = XLON(JI,JJ)
- ZLAT = XLAT(JI,JJ)
- IF (KRTTOVINFO(1,JSAT) == 2) THEN ! DMSP PLATFORM
- ZANGL=53.1 ! see Saunders, 2002, RTTOV7 - science/validation rep, page 8
- ELSEIF (KRTTOVINFO(1,JSAT) == 3) THEN ! METEOSAT PLATFORM
- CALL DETER_ANGLE(5, 1, ZLAT, ZLON, ZANGL)
- WHERE (ZANGL /= XUNDEF .AND. ZANGL /=0.) ZANGL=ACOS(1./ZANGL)*180./XPI
- ELSEIF (KRTTOVINFO(1,JSAT) == 12) THEN ! MSG PLATFORM
- CALL DETER_ANGLE(6, 1, ZLAT, ZLON, ZANGL)
- WHERE (ZANGL /= XUNDEF .AND. ZANGL /=0.) ZANGL=ACOS(1./ZANGL)*180./XPI
- ELSEIF (KRTTOVINFO(1,JSAT) == 4) THEN ! GOES-E PLATFORM
- CALL DETER_ANGLE(1, 1, ZLAT, ZLON, ZANGL)
- WHERE (ZANGL /= XUNDEF .AND. ZANGL /=0.) ZANGL=ACOS(1./ZANGL)*180./XPI
- ELSEIF (KRTTOVINFO(1,JSAT) == 7) THEN ! TRMM PLATFORM
- ZANGL=52.3
- ELSE
- ZANGL=0.
- ENDIF
-! Coefficients computed from transmittances for 6 viewing angles in the range
-! 0 to 63.6 deg (Saunders, 2002, RTTOV7 - science/validation rep., page 3)
- profiles(1) % zenangle = MIN(ZANGL(1),65.)
-
- DO JK=IKB,IKE ! nlevels
- JKRAD = nlev-JK+2 !INVERSION OF VERTICAL LEVELS!
-! PRINT *,'jk=',jk,' jkrad=',jkrad
- profiles(1) % p(JKRAD) = PPABST(JI,JJ,JK)*0.01
- profiles(1) % t(JKRAD) = MIN(tmax,MAX(tmin,ZTEMP(JI,JJ,JK)))
-! PRINT *,'jk=',JK,' ZTEMP=',ZTEMP(JI,JJ,JK),' t=',profiles(1) % t(JKRAD)
- profiles(1) % q(JKRAD) = MIN(qmax,MAX(qmin,PRT(JI,JJ,JK,1)*q_mixratio_to_ppmv))
-! PRINT *,JK,profiles(1) % p(JKRAD) ,profiles(1) % t(JKRAD) ,profiles(1) % q(JKRAD)
- END DO
- profiles(1) % elevation = 0.5*( PZZ(JI,JJ,1)+PZZ(JI,JJ,IKB) )
- profiles(1) % skin % t = MIN(tmax,MAX(tmin,PTSRAD(JI,JJ)))
- profiles(1) % s2m % t = MIN(tmax,MAX(tmin,ZTEMP(JI,JJ,IKB)))
- profiles(1) % s2m % q = MIN(qmax,MAX(qmin,PRT(JI,JJ,1,IKB)*q_mixratio_to_ppmv))
- profiles(1) % s2m % u = PULVLKB(JI,JJ) ! 2m wind speed u (m/s)
- profiles(1) % s2m % v = PVLVLKB(JI,JJ) ! 2m wind speed v (m/s)
- profiles(1) % s2m % p = PPABST(JI,JJ,IKB)*0.01
- IF (NINT(XSEA(JI,JJ)).EQ.0.) THEN
- profiles(1) % skin % surftype = 0 ! Surface Mask 0=land, 1=sea, 2=sea-ice
- ELSE
- profiles(1) % skin % surftype = 1
- profiles(1) % skin % watertype = 1 ! Ocean water
- END IF
- profiles(1) % ctp = 500.0_JPRB ! Not used but still required by RTTOV
- IF( coef_rttov%coef% id_sensor /= sensor_id_mw) THEN
- profiles(1)%ish = 2 ! Aggregates
- profiles(1)%idg = 4 ! McFarquar et al (2003)
- DO JK=IKB+1,IKE-1 ! nlayers
- JKRAD = nlev-JK+1 !INVERSION OF VERTICAL LEVELS!
- profiles(1) %cfrac(JKRAD) = PCLDFR(JI,JJ,JK)
- profiles(1) %cloud(1,JKRAD) = PRT(JI,JJ,JK,2)*XRHODREF(JI,JJ,JK)*1.0E03
- IF( OUSERI ) THEN
- profiles(1) %cloud(6,JKRAD) = (PRT(JI,JJ,JK,4)+PRT(JI,JJ,JK,5)) \
- *XRHODREF(JI,JJ,JK)*1.0E03
- END IF
- END DO
- ELSE
- DO JK=IKB,IKE
- JKRAD = nlev-JK+2 !INVERSION OF VERTICAL LEVELS!
- cld_profiles(1) %ph (JKRAD) = 0.5*( PPABST(JI,JJ,JK) + PPABST(JI,JJ,JK+1) )*0.01
- cld_profiles(1) %cc(JKRAD) = PCLDFR(JI,JJ,JK)
- cld_profiles(1) %clw(JKRAD) = MIN(ZRCMAX,PRT(JI,JJ,JK,2))
- cld_profiles(1) %rain(JKRAD) = MIN(ZRRMAX,PRT(JI,JJ,JK,3))
- IF( OUSERI ) THEN
- cld_profiles(1) %ciw(JKRAD) = MIN(ZRIMAX,PRT(JI,JJ,JK,4))
- cld_profiles(1) %sp(JKRAD) = MIN(ZRSMAX,PRT(JI,JJ,JK,5)+PRT(JI,JJ,JK,6))
- END IF
- END DO
- cld_profiles (1) % ph (nlev+1) = profiles (1) % s2m % p
-! PRINT *,nlev+1,' cld_profiles(1) % ph (nlev+1) =',cld_profiles(1) % ph (nlev+1)
- END IF
-
- DO JCH=1,nchannels
- IF (.NOT.calcemis(JCH)) emissivity(JCH)%emis_in = PEMIS(JI,JJ)
- END DO
-
-! write(*,*) 'Calling forward model'
-
-! Forward model run
- IF ( coef_rttov%coef% id_sensor /= sensor_id_mw) THEN
- CALL rttov_direct( &
- & errorstatus, &! out error flag
- & chanprof, &! in channel and profile index structure
- & opts, &! in options structure
- & profiles, &! in profile array
- & coef_rttov, &! in coefficients strucutre
- & transmission, &! inout compscauted transmittances
- & radiance, &! inout computed radiances
- & calcemis = calcemis, &! in flag for internal emissivity calcs
- & emissivity = emissivity) !, &! inout input/output emissivities per channel
-! & calcrefl = calcrefl, &! in flag for internal BRDF calcs
-! & reflectance = reflectance) ! inout input/output BRDFs per channel
- ELSE
- CALL rttov_scatt ( &
- & errorstatus, &! out
- & opts_scatt, &! in
- & nlev, &! in
- & chanprof, &! in
- & frequencies, &! in
- & profiles, &! in
- & cld_profiles, &! in
- & coef_rttov, &! in
- & coef_scatt, &! in
- & calcemis, &! in
- & emissivity, &! in
- & radiance) ! out
- END IF
-! STOP
- DO JCH=1,nchannels
- ZBT(JI,JJ,JCH)= radiance % bt(JCH)
- END DO
- END DO
- END DO
-! -----------------------------------------------------------------------------
-! LATERAL BOUNDARY FILLING
- IF (LWEST_ll() .AND.CLBCX(1)/='CYCL') ZOUT(IIB-1,:,:) = ZOUT(IIB,:,:)
- IF (LEAST_ll() .AND.CLBCX(1)/='CYCL') ZOUT(IIE+1,:,:) = ZOUT(IIE,:,:)
- IF (LSOUTH_ll().AND.CLBCY(1)/='CYCL') ZOUT(:,IJB-1,:) = ZOUT(:,IJB,:)
- IF (LNORTH_ll().AND.CLBCY(1)/='CYCL') ZOUT(:,IJE+1,:) = ZOUT(:,IJE,:)
-! -----------------------------------------------------------------------------
- YBEG=' '
- IF (KRTTOVINFO(1,JSAT) <= 2 .OR. KRTTOVINFO(1,JSAT) == 4) THEN ! NOAA
- WRITE(YTWO,'(I2.2)') KRTTOVINFO(2,JSAT)
- YBEG=TRIM(YPLAT(KRTTOVINFO(1,JSAT)))//YTWO
- ELSEIF (KRTTOVINFO(1,JSAT) <= JPPLAT) THEN
- WRITE(YONE,'(I1.1)') KRTTOVINFO(2,JSAT)
- YBEG=TRIM(YPLAT(KRTTOVINFO(1,JSAT)))//YONE
- ELSE
- YBEG='XXXX'
- END IF
- WRITE(YTWO,'(I2.2)') KRTTOVINFO(3,JSAT)
-
- DO JCH=1,nchannels
- YEND=' '
- WRITE(YCHAN,'(I2.2)') JCH
- IF (KRTTOVINFO(3,JSAT) == 0) THEN ! HIRS
- YEND='H'//YCHAN
- ELSEIF (KRTTOVINFO(3,JSAT) == 3) THEN ! AMSU-A
- YEND='A'//YCHAN
- ELSEIF (KRTTOVINFO(3,JSAT) == 4) THEN ! AMSU-B
- YEND='B'//YCHAN
- ELSEIF (KRTTOVINFO(3,JSAT) == 6) THEN ! SSMI
- YEND=YLBL_SSMI(JCH)
- ELSEIF (KRTTOVINFO(3,JSAT) == 9) THEN ! TMI
- YEND=YLBL_TMI(JCH)
- ELSEIF (KRTTOVINFO(3,JSAT) == 20) THEN ! MVIRI
- YEND=YLBL_MVIRI(JCH)
- ELSEIF (KRTTOVINFO(3,JSAT) == 21) THEN ! SEVIRI
- YEND=YLBL_SEVIRI(JCH)
- ELSEIF (KRTTOVINFO(3,JSAT) == 22) THEN ! GOES-I
- YEND=YLBL_GOESI(JCH)
- ELSE
- YEND=YTWO//YCHAN
- END IF
-
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = TRIM(YBEG)//'_'//TRIM(YEND)//'BT', &
- CSTDNAME = '', &
- CLONGNAME = TRIM(YBEG)//'_'//TRIM(YEND)//'BT', &
- CUNITS = 'K', &
- CDIR = 'XY', &
- CCOMMENT = TRIM(YBEG)//'_'//TRIM(YEND)//' BT', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
-! PRINT *,'YRECFM='//TRIM(TZFIELD%CMNHNAME)
- CALL IO_Field_write(TPFILE,TZFIELD,ZBT(:,:,JCH))
- END DO
- DEALLOCATE(chanprof,frequencies,emissivity,calcemis,profiles)
- DEALLOCATE(ZBT)
- IF( coef_rttov%coef% id_sensor == sensor_id_mw) THEN
- CALL rttov_alloc_scatt_prof(nprof, cld_profiles, nlev, .FALSE., 0_jpim)
- CALL rttov_dealloc_scattcoeffs(coef_scatt)
- END IF
- DEALLOCATE(cld_profiles)
- CALL rttov_dealloc_coefs(errorstatus, coef_rttov)
-! IF( coef_rttov%coef% id_sensor /= sensor_id_mw) THEN
-! DEALLOCATE(calcrefl,reflectance)
-! END IF
-END DO
-
-#else
-PRINT *, "RTTOV 11.1 LIBRARY NOT AVAILABLE = ###CALL_RTTOV11####"
-#endif
-!
-END SUBROUTINE CALL_RTTOV11
diff --git a/src/MNH/call_rttov13.f90 b/src/MNH/call_rttov13.f90
index 8c681d530..4ae377c93 100644
--- a/src/MNH/call_rttov13.f90
+++ b/src/MNH/call_rttov13.f90
@@ -247,6 +247,7 @@ CHARACTER(LEN=2), DIMENSION(6) :: YLBL_SAPHIR = (/ &
CHARACTER(LEN=4), DIMENSION(13) :: YLBL_ICI = (/ &
'1837','1833','1832','243V','243H','3259','3253','3251','4487','4483','4481','664V','664H'/)
CHARACTER(LEN=4), DIMENSION(2) :: YLBL_DPR = (/ '13', '35' /)
+CHARACTER(LEN=4), DIMENSION(1) :: YLBL_CPR = (/ '94' /)
CHARACTER(LEN=4), DIMENSION(13) :: YLBL_GMI = (/ &
'10V','10H','18V','18H','23V','36V','36H','89V','89H','166V','166H','1833','1837'/)
@@ -354,7 +355,7 @@ DO JSAT=1,IJSAT ! loop over sensors
opts % rt_ir % addaerosl = .FALSE. ! Do not include aerosol effects
opts % rt_ir % addclouds = .FALSE. ! Do not include cloud effects
opts % rt_mw % clw_data = .FALSE. ! Do not include cloud liquid water
- IF (KRTTOVINFO(3,JSAT).EQ.105.OR.KRTTOVINFO(3,JSAT).EQ.106) radar = .TRUE.
+ IF (KRTTOVINFO(3,JSAT).EQ.105.OR.KRTTOVINFO(3,JSAT).EQ.107) radar = .TRUE.
END IF
! Read and initialise coefficients
@@ -750,6 +751,9 @@ DO JSAT=1,IJSAT ! loop over sensors
ELSEIF (KRTTOVINFO(3,JSAT) == 105) THEN ! DPR
YBEG='dpr'
YEND=YLBL_DPR(JCH)
+ ELSEIF (KRTTOVINFO(3,JSAT) == 107) THEN ! CPR
+ YBEG='cpr'
+ YEND=YLBL_CPR(JCH)
ELSE
YEND=YTWO//YCHAN
END IF
diff --git a/src/MNH/call_rttov8.f90 b/src/MNH/call_rttov8.f90
deleted file mode 100644
index ab370816e..000000000
--- a/src/MNH/call_rttov8.f90
+++ /dev/null
@@ -1,1806 +0,0 @@
-!MNH_LIC Copyright 2003-2020 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! #######################
- MODULE MODI_CALL_RTTOV8
-! #######################
-INTERFACE
-!
- SUBROUTINE CALL_RTTOV8(KDLON, KFLEV, KSTATM, PEMIS, PTSRAD, PSTATM, &
- PTHT, PRT, PPABST, PZZ, PMFCONV, PCLDFR, PULVLKB, PVLVLKB, &
- OUSERI, KRTTOVINFO, TPFILE )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KDLON !number of columns where the
- !radiation calculations are performed
-INTEGER, INTENT(IN) :: KFLEV !number of vertical levels where the
- !radiation calculations are performed
-INTEGER, INTENT(IN) :: KSTATM !index of the standard atmosphere level
- !just above the model top
-!
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PEMIS !Surface IR EMISsivity
-REAL, DIMENSION(:,:), INTENT(IN) :: PTSRAD !RADiative Surface Temperature
-REAL, DIMENSION(:,:), INTENT(IN) :: PSTATM !selected standard atmosphere
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT !THeta at t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT !moist variables at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST !pressure at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ !Model level heights
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV! convective mass flux (kg /s m^2)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! cloud fraction
-REAL, DIMENSION(:,:), INTENT(IN) :: PULVLKB ! U-wind at KB level
-REAL, DIMENSION(:,:), INTENT(IN) :: PVLVLKB ! V-wind at KB level
-!
-LOGICAL, INTENT(IN) :: OUSERI ! logical switch to compute both
- ! liquid and solid condensate (OUSERI=.TRUE.)
- ! or only liquid condensate (OUSERI=.FALSE.)
-!
-INTEGER, DIMENSION(:,:), INTENT(IN) :: KRTTOVINFO ! platform, satelit, sensor,
- ! and selection calculations
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File characteristics
-!
-END SUBROUTINE CALL_RTTOV8
-END INTERFACE
-END MODULE MODI_CALL_RTTOV8
-! #####################################################################
-SUBROUTINE CALL_RTTOV8(KDLON, KFLEV, KSTATM, PEMIS, PTSRAD, PSTATM, &
- PTHT, PRT, PPABST, PZZ, PMFCONV, PCLDFR, PULVLKB, PVLVLKB, &
- OUSERI, KRTTOVINFO, TPFILE )
-! #####################################################################
-!!
-!!**** *CALL_RTTOV* -
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!! See Chaboureau and Pinty, 2006
-!! Validation of a cirrus parameterization with Meteosat Second Generation
-!! observations. Geophys. Res. Let., doi:10.1029/2005GL024725
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Chaboureau *L.A.*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 11/12/03
-!! JP Chaboureau 27/03/2008 Vectorization
-!! JP Chaboureau 02/11/2009 move GANGL deallocation outside the sensor loop
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!----------------------------------------------------------------------------
-!!
-!!* 0. DECLARATIONS
-!! ------------
-!!
-USE MODD_CST
-USE MODD_FIELD, only: TFIELDMETADATA
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_PARAMETERS
-USE MODD_GRID_n
-USE MODD_DEEP_CONVECTION_n
-USE MODD_REF_n
-USE MODD_RADIATIONS_n, ONLY : XSEA
-!
-USE MODN_CONF
-!
-USE MODD_RAD_TRANSF
-!
-USE MODI_DETER_ANGLE
-USE MODI_PINTER
-!
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
-USE MODE_ll
-USE MODE_MSG
-USE MODE_POS
-!
-#ifdef MNH_RTTOV_8
-USE rttov_const, ONLY : &
- & gas_id_watervapour ,&
- & errorstatus_success,&
- & errorstatus_warning,&
- & errorstatus_fatal,&
- & sensor_id_mw, &
- & npolar_return, &
- & npolar_compute
-
-
-USE rttov_types, ONLY : &
- & geometry_type ,&
- & rttov_coef ,&
- & rttov_scatt_coef ,&
- & profile_type ,&
- & profile_cloud_type ,&
- & transmission_type ,&
- & radiance_cloud_type
-
-USE MOD_CPARAM, ONLY : jppf ! Max no. profiles
-
-USE parkind1, ONLY : jpim ,jprb
-!
-IMPLICIT NONE
-!
-! -----------------------------------------------------------------------------
-INTERFACE
-
-!!! #include "rttov_setupindex.interface
-SUBROUTINE rttov_setupindex (&
- & mchan, & ! in
- & nprofiles, & ! in
- & nfrequencies, & ! in
- & nchannels, & ! in
- & nbtout, & ! in
- & coef, & ! in
- & surfem, & ! in
- & lprofiles, & ! out
- & channels, & ! out
- & polarisations, & ! out
- & emissivity) ! out
-! Imported Type Definitions:
-USE rttov_types, ONLY : &
- rttov_coef
-USE rttov_const, ONLY : &
- sensor_id_mw, &
- npolar_return, &
- npolar_compute
-
-USE parkind1, ONLY : jpim ,jprb
-IMPLICIT NONE
-! Subroutine arguments
-INTEGER(Kind=jpim), INTENT(in) :: nprofiles ! Number of profiles
-INTEGER(Kind=jpim), INTENT(in) :: mchan(nprofiles) ! nfrequencies/nprofiles
-INTEGER(Kind=jpim), INTENT(in) :: nchannels ! Number of radiances computed
-INTEGER(Kind=jpim), INTENT(in) :: nfrequencies ! Number of frequencies
-! (= channels used * profiles)
-INTEGER(Kind=jpim), INTENT(in) :: nbtout ! Number of BTs returned
-INTEGER(Kind=jpim), INTENT(out) :: channels(nfrequencies) ! Channel indices
-INTEGER(Kind=jpim), INTENT(out) :: polarisations(nchannels,3) ! Channel indices
-INTEGER(Kind=jpim), INTENT(out) :: lprofiles(nfrequencies) ! Profiles indices
-REAL(Kind=jprb), INTENT(in) :: surfem(nchannels) ! Input surface emissivity
-REAL(Kind=jprb), INTENT(out) :: emissivity(nchannels) ! Surface emissivity array for RTTOV
-TYPE( rttov_coef ), INTENT (in) :: coef ! coefficients
-END SUBROUTINE rttov_setupindex
-!
-!!! #include "rttov_setupchan.interface"
-SUBROUTINE rttov_setupchan (&
- & nprofiles, & ! in
- & nchan, & ! in
- & coef, & ! in
- & nfrequencies, & ! out
- & nchannels, & ! out
- & nbtout) ! out
- ! Imported Type Definitions:
-USE rttov_types, ONLY : &
- rttov_coef
-USE rttov_const, ONLY : &
- sensor_id_mw, &
- npolar_return, &
- npolar_compute
-USE parkind1, ONLY : jpim
-IMPLICIT NONE
-! Subroutine arguments
-INTEGER(Kind=jpim), INTENT(in) :: nprofiles ! Number of profiles
-INTEGER(Kind=jpim), INTENT(in) :: nchan(nprofiles) ! Number of channels requested
-TYPE( rttov_coef ), INTENT (in) :: coef ! coefficients
-INTEGER(Kind=jpim), INTENT(out) :: nchannels ! Number of radiances computed
-INTEGER(Kind=jpim), INTENT(out) :: nfrequencies ! Number of frequencies
-! (= channels used * profiles)
-INTEGER(Kind=jpim), INTENT(out) :: nbtout ! Number of BTs returned
-END SUBROUTINE rttov_setupchan
-!
-!!! #include "rttov_scatt_setupindex.interface"
-SUBROUTINE rttov_scatt_setupindex (nprofiles, n_chan, coef, nchannels, &
- & lsprofiles,lsprofiles2, frequencies, nbtout)
-USE parkind1 , ONLY: jpim, jprb
-USE rttov_const, ONLY : npolar_return, npolar_compute, &
- & inst_id_ssmi
-USE rttov_types, ONLY : rttov_coef
-IMPLICIT NONE
-INTEGER (kind=jpim), INTENT ( in) :: nprofiles
-INTEGER (kind=jpim), INTENT ( in) :: nchannels
-INTEGER (kind=jpim), INTENT ( in) :: nbtout
-INTEGER (kind=jpim), INTENT ( in) :: n_chan (nprofiles)
-TYPE (rttov_coef), INTENT ( in) :: coef
-INTEGER (kind=jpim), INTENT (out), DIMENSION (nchannels) :: lsprofiles
-INTEGER (kind=jpim), INTENT (out), DIMENSION (nbtout) :: lsprofiles2
-INTEGER (kind=jpim), INTENT (out), DIMENSION (nchannels) :: frequencies
-END SUBROUTINE rttov_scatt_setupindex
-!
-!!! #include "rttov_cld.interface"
-SUBROUTINE rttov_cld( &
- errorstatus, & ! out
- nfrequencies, & ! in
- nchannels, & ! in
- nbtout, & ! in
- nprofiles, & ! in
- channels, & ! in
- polarisations, & ! in
- lprofiles, & ! in
- profiles, & ! inout (to invalid clw absorption)
- cld_profiles, & ! in
- coef, & ! in
- calcemis, & ! in
- emissivity, & ! inout
- cld_radiance ) ! inout
-USE rttov_const, ONLY : &
- errorstatus_success ,&
- errorstatus_fatal ,&
- overlap_scheme
-USE rttov_types, ONLY : &
- rttov_coef ,&
- geometry_Type ,&
- profile_Type ,&
- profile_cloud_Type ,&
- transmission_Type ,&
- radiance_Type ,&
- radiance_cloud_Type
-USE parkind1, ONLY : jpim ,jprb
-IMPLICIT NONE
-INTEGER(Kind=jpim), INTENT(in) :: nbtout ! Number of output radiances
-INTEGER(Kind=jpim), INTENT(in) :: nfrequencies ! Number of output radiances
-INTEGER(Kind=jpim), INTENT(in) :: nchannels
-INTEGER(Kind=jpim), INTENT(in) :: nprofiles
-INTEGER(Kind=jpim), INTENT(in) :: channels(nfrequencies)
-INTEGER(Kind=jpim), INTENT(in) :: polarisations(nchannels,3) ! Channel indices
-INTEGER(Kind=jpim), INTENT(in) :: lprofiles(nfrequencies)
-TYPE(profile_Type), INTENT(inout) :: profiles(nprofiles) ! Profiles on RTTOV levels
-TYPE(profile_cloud_Type), INTENT(in) :: cld_profiles(nprofiles) ! Cloud profiles on NWP levels
-TYPE(rttov_coef), INTENT(in) :: coef ! Coefficients
-LOGICAL, INTENT(in) :: calcemis(nchannels) ! switch for emmissivity calc.
-REAL(Kind=jprb), INTENT(inout) :: emissivity(nchannels) ! surface emmissivity
-TYPE(radiance_cloud_Type), INTENT(inout) :: cld_radiance ! radiances (mw/cm-1/ster/sq.m)
-INTEGER(Kind=jpim), INTENT(out) :: errorstatus(nprofiles) ! return flag
-END SUBROUTINE rttov_cld
-
-!!! #include "rttov_cld_k.interface"
-SUBROUTINE Rttov_cld_k ( &
- errorstatus, & ! out
- nfrequencies, & ! in
- nchannels, & ! in
- nbtout, & ! in
- nprofiles, & ! in
- channels, & ! in
- polarisations, & ! in
- lprofiles, & ! in
- profiles, & ! in
- cld_profiles, & ! in
- coef, & ! in
- switchrad, & ! in
- calcemis, & ! in
- emissivity, & ! inout
- profiles_k , & ! inout
- cld_profiles_k ,& ! inout
- emissivity_k , & ! inout
- cld_radiance) ! inout
-USE rttov_const, ONLY : &
- errorstatus_success ,&
- errorstatus_fatal ,&
- overlap_scheme
-USE rttov_types, ONLY : &
- rttov_coef ,&
- geometry_Type ,&
- profile_Type ,&
- profile_cloud_Type ,&
- radiance_cloud_Type
-USE parkind1, ONLY : jpim ,jprb
-IMPLICIT NONE
-INTEGER(Kind=jpim), INTENT(in) :: nfrequencies
-INTEGER(Kind=jpim), INTENT(in) :: nchannels
-INTEGER(Kind=jpim), INTENT(in) :: nbtout
-INTEGER(Kind=jpim), INTENT(in) :: nprofiles
-INTEGER(Kind=jpim), INTENT(in) :: channels(nfrequencies)
-INTEGER(Kind=jpim), INTENT(in) :: polarisations(nchannels,3)
-INTEGER(Kind=jpim), INTENT(in) :: lprofiles(nfrequencies)
-LOGICAL, INTENT(in) :: switchrad ! true if input is BT
-TYPE(profile_Type), INTENT(inout) :: profiles(nprofiles)
-TYPE(profile_cloud_Type), INTENT(in) :: cld_profiles(nprofiles)
-TYPE(rttov_coef), INTENT(in) :: coef
-LOGICAL, INTENT(in) :: calcemis(nchannels)
-REAL(Kind=jprb), INTENT(inout) :: emissivity(nchannels)
-TYPE(radiance_cloud_type), INTENT(inout) :: cld_radiance! in because of meme allocation
-TYPE(profile_Type), INTENT(inout) :: profiles_k(nchannels)
-TYPE(profile_cloud_Type), INTENT(inout) :: cld_profiles_k(nchannels)
-REAL(Kind=jprb), INTENT(inout) :: emissivity_k(nchannels)
-INTEGER(Kind=jpim), INTENT(out) :: errorstatus(nprofiles)
-END SUBROUTINE Rttov_cld_k
-
-
-!!! #include "rttov_scatt.interface"
-SUBROUTINE rttov_scatt(&
- & errorstatus,&
- & nwp_levels,&
- & nrt_levels,&
- & nfrequencies,&
- & nchannels,&
- & nbtout,&
- & nprofiles,&
- & polarisations,&
- & channels,&
- & frequencies,&
- & lprofiles,&
- & lsprofiles,&
- & profiles,&
- & cld_profiles,&
- & coef_rttov,&
- & coef_scatt,&
- & calcemiss,&
- & emissivity_in,&
- & cld_radiance )
-USE rttov_types, ONLY :&
- & rttov_coef ,&
- & rttov_scatt_coef ,&
- & geometry_Type ,&
- & profile_Type ,&
- & profile_cloud_Type ,&
- & profile_scatt_aux ,&
- & transmission_Type ,&
- & radiance_Type ,&
- & radiance_cloud_Type
-USE parkind1, ONLY : jpim ,jprb
-INTEGER (Kind=jpim), INTENT (in) :: nwp_levels
-INTEGER (Kind=jpim), INTENT (in) :: nrt_levels
-INTEGER (Kind=jpim), INTENT (in) :: nprofiles
-INTEGER (Kind=jpim), INTENT (in) :: nfrequencies
-INTEGER (Kind=jpim), INTENT (in) :: nchannels
-INTEGER (Kind=jpim), INTENT (in) :: nbtout
-INTEGER (Kind=jpim), INTENT (in) :: channels (nfrequencies)
-INTEGER (Kind=jpim), INTENT (in) :: frequencies (nchannels)
-INTEGER (Kind=jpim), INTENT (in) :: polarisations (nchannels,3)
-INTEGER (Kind=jpim), INTENT (in) :: lprofiles (nfrequencies)
-INTEGER (Kind=jpim), INTENT (in) :: lsprofiles (nchannels)
-INTEGER (Kind=jpim), INTENT (out) :: errorstatus (nprofiles)
-LOGICAL, INTENT (in) :: calcemiss (nchannels)
-REAL (Kind=jprb), INTENT (in) :: emissivity_in (nchannels)
-TYPE (profile_Type), INTENT (inout) :: profiles (nprofiles)
-TYPE (rttov_coef), INTENT (in) :: coef_rttov
-TYPE (rttov_scatt_coef), INTENT (in) :: coef_scatt
-TYPE (profile_cloud_Type), INTENT (in) :: cld_profiles (nprofiles)
-TYPE (radiance_cloud_Type), INTENT (inout) :: cld_radiance
-END SUBROUTINE rttov_scatt
-
-!!! #include "rttov_readcoeffs.interface"
-SUBROUTINE rttov_readcoeffs (&
- & errorstatus, & ! out
- & coef, & ! out
- & instrument, & ! in Optional
- & kmyproc, & ! in Optional
- & kioproc, & ! in Optional
- & file_id, & ! in Optional
- & channels ) ! in Optional
-USE rttov_const, ONLY : &
- version ,&
- release ,&
- minor_version ,&
- rttov_magic_string ,&
- sensor_id_mw ,&
- sensor_id_ir ,&
- errorstatus_info ,&
- errorstatus_success ,&
- errorstatus_fatal ,&
- gas_id_mixed ,&
- gas_id_watervapour ,&
- gas_id_ozone ,&
- gas_id_wvcont ,&
- gas_id_co2 ,&
- gas_id_n2o ,&
- gas_id_co ,&
- gas_id_ch4 ,&
- gas_unit_specconc ,&
- gas_unit_ppmv ,&
- earthradius ,&
- gas_name ,&
- pressure_top
-USE rttov_types, ONLY : &
- rttov_coef
-USE parkind1, ONLY : jpim ,jprb
-IMPLICIT NONE
-INTEGER(Kind=jpim), OPTIONAL, INTENT(in) :: kmyproc ! logical processor id
-INTEGER(Kind=jpim), OPTIONAL, INTENT(in) :: kioproc ! processor dedicated for io
-INTEGER(Kind=jpim), OPTIONAL, INTENT (in) :: instrument(3) ! (platform, satellite identification, instrument) number
-INTEGER(Kind=jpim), OPTIONAL, INTENT (in) :: file_id ! file logical unit number
-INTEGER(Kind=jpim), OPTIONAL, INTENT (in) :: channels(:) ! list of channels to extract
-INTEGER(Kind=jpim), INTENT (out) :: errorstatus ! return code
-TYPE( rttov_coef ), INTENT (out) :: coef ! coefficients
-END SUBROUTINE rttov_readcoeffs
-
-!!! #include "rttov_initcoeffs.interface"
-SUBROUTINE rttov_initcoeffs (&
- & errorstatus, &! out
- & coef, &! out
- & knproc, &! in Optional
- & kmyproc, &! in Optional
- & kioproc )! in Optional
-USE rttov_const, ONLY : &
- & sensor_id_mw ,&
- & errorstatus_info ,&
- & errorstatus_success ,&
- & errorstatus_fatal ,&
- & gas_id_mixed ,&
- & gas_id_watervapour ,&
- & gas_id_ozone ,&
- & gas_id_wvcont ,&
- & gas_id_co2 ,&
- & gas_id_n2o ,&
- & gas_id_co ,&
- & gas_id_ch4 ,&
- & gas_unit_specconc ,&
- & gas_unit_ppmv ,&
- & earthradius ,&
- & gas_name ,&
- & pressure_top
-! Imported Type Definitions:
-USE rttov_types, ONLY : &
- & rttov_coef
-USE parkind1, ONLY : jpim ,jprb
-IMPLICIT NONE
-INTEGER(Kind=jpim), OPTIONAL, INTENT(in) :: knproc ! number of procs
-INTEGER(Kind=jpim), OPTIONAL, INTENT(in) :: kmyproc ! logical processor id
-INTEGER(Kind=jpim), OPTIONAL, INTENT(in) :: kioproc ! procs dedicated for io
-! scalar arguments with intent(out):
-INTEGER(Kind=jpim), INTENT (out) :: errorstatus ! return code
-TYPE( rttov_coef ), INTENT (out) :: coef ! coefficients
-END SUBROUTINE rttov_initcoeffs
-
-!!! #include "rttov_readscattcoeffs.interface"
-SUBROUTINE rttov_readscattcoeffs (&
- & errorstatus, &! out
- & coef_rttov, &! in
- & coef_scatt, &! out
- & file_id ) ! in Optional
-! Imported Type Definitions:
-USE rttov_types, ONLY : &
- & rttov_coef, &
- & rttov_scatt_coef
-USE rttov_const, ONLY : &
- & inst_name ,&
- & platform_name ,&
- & errorstatus_info ,&
- & errorstatus_success ,&
- & errorstatus_fatal
-USE parkind1, ONLY : jpim ,jprb
-IMPLICIT NONE
-! subroutine arguments
-! scalar arguments with intent(out):
-INTEGER(Kind=jpim), INTENT (out) :: errorstatus ! return code
-! scalar arguments with optional intent(in):
-INTEGER(Kind=jpim), OPTIONAL, INTENT (in) :: file_id ! file logical unit number
-! array arguments with intent(in):
-TYPE( rttov_coef ), INTENT (in) :: coef_rttov ! clear-sky coefficients
-! array arguments with intent(out):
-TYPE( rttov_scatt_coef ), INTENT (out) :: coef_scatt ! coefficients
-END SUBROUTINE rttov_readscattcoeffs
-
-END INTERFACE
-!!! #include "rttov_opencoeff.interface"
-!!! #include "rttov_errorhandling.interface"
-!!! #include "rttov_dealloc_coef.interface"
-!!! #include "rttov_errorreport.interface"
-#endif
-!!!
-!!!* 0.1 DECLARATIONS OF DUMMY ARGUMENTS :
-!!!
-INTEGER, INTENT(IN) :: KDLON !number of columns where the
-! radiation calculations are performed
-INTEGER, INTENT(IN) :: KFLEV !number of vertical levels where the
-! radiation calculations are performed
-INTEGER, INTENT(IN) :: KSTATM !index of the standard atmosphere level
- !just above the model top
-!!!
-REAL, DIMENSION(:,:), INTENT(IN) :: PEMIS !Surface IR EMISsivity
-REAL, DIMENSION(:,:), INTENT(IN) :: PTSRAD !RADiative Surface Temperature
-REAL, DIMENSION(:,:), INTENT(IN) :: PSTATM !selected standard atmosphere
- !
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT !THeta at t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT !moist variables at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST !pressure at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ !Model level heights
-!!!
-!!!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV! convective mass flux (kg /s m^2)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! cloud fraction
-REAL, DIMENSION(:,:), INTENT(IN) :: PULVLKB ! U-wind at KB level
-REAL, DIMENSION(:,:), INTENT(IN) :: PVLVLKB ! V-wind at KB level
-!!!
-LOGICAL, INTENT(IN) :: OUSERI ! logical switch to compute both
-! liquid and solid condensate (OUSERI=.TRUE.)
-! or only liquid condensate (OUSERI=.FALSE.)
-!!!
-INTEGER, DIMENSION(:,:), INTENT(IN) :: KRTTOVINFO ! platform, satelit, sensor,
- ! and selection calculations
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File characteristics
-!
-#ifdef MNH_RTTOV_8
-!!!
-!!!* 0.2 DECLARATIONS OF LOCAL VARIABLES
-!!!
-!!!
-INTEGER, PARAMETER :: JPNSAT=3 ! No. of Satellite required
- !
-INTEGER :: JI,JJ,JK,JK1,JK2,JKRAD,JKF,JSAT,JC ! loop indexes
- !
-INTEGER :: IJSAT ! number of columns/=NUNDEF which
- ! have to be treated in the table KRTTOVINFO(:,:)
-INTEGER :: IIB,IIE ! I index value of the first/last inner mass point
-INTEGER :: IJB,IJE ! J index value of the first/last inner mass point
-INTEGER :: IKB,IKE ! K index value of the first/last inner mass point
-INTEGER :: IIU ! array size for the first index
-INTEGER :: IJU ! array size for the second index
-INTEGER :: IKU ! array size for the third index
-INTEGER :: IKR ! real array size for the third index
-INTEGER (Kind=jpim) :: iwp_levels ! equal to IKR (call to rttov_scatt)
-INTEGER :: IIJ ! reformatted array index
-INTEGER :: IKSTAE ! level number of the STAndard atmosphere array
-INTEGER :: IKUP ! vertical level above which STAndard atmosphere data
-INTEGER, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,3)) :: IKKOZ ! indice array used to
-! vertically interpolate the ozone content on the model grid
- !
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZPAVE ! mean-layer pressure
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZTAVE ! mean-layer temperature
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZQVAVE ! mean-layer specific humidity
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZO3AVE ! mean-layer ozone content
-REAL, DIMENSION(:), ALLOCATABLE :: ZREMIS ! Reformatted PEMIS array
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEXNT ! Exner function
-REAL, DIMENSION(SIZE(PSTATM,1)) :: ZSTAZZ,ZSTAOZ ! STAndard atmosphere height
-! and OZone content
-REAL :: ZOZ ! variable used to interpolate the ozone profile
-
-REAL, DIMENSION(:), ALLOCATABLE :: ZULAT
-REAL, DIMENSION(:), ALLOCATABLE :: ZULON
-
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTBTMP
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZANTMP, ZUTH
-REAL :: ZZH, zdeg_to_rad, zrad_to_deg, zbeta, zalpha
-
-! Other arrays for zenithal solar angle
-! REAL, DIMENSION(:,:), ALLOCATABLE :: ZCOSZEN, ZSINZEN, ZAZIMSOL
-
-! Other arrays for condensation
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTEMP ! Temperature
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZNCLD ! grid scale cloud fraction
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRC ! grid scale r_c (kg/kg)
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRI ! grid scale r_i (kg/kg)
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRR ! grid scale r_r (kg/kg)
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRS ! grid scale r_s (kg/kg)
-! -----------------------------------------------------------------------------
-INTEGER, PARAMETER :: JPLEV=43, JPNAV=3, JPNSAV=5, JPNSSV=6, JPNCVCLD=6
-
-REAL, DIMENSION(JPLEV) :: ZPRES !Fixed level pressures used in RTTOV
-REAL, DIMENSION(JPLEV) :: ZPRES_INV
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZAV !Profile array content
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZSAV !Surface array content
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZSSV !Surface Skin array content
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZAP !Full-level Model Pressure (hPa)
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZAP_HL !Half-level Model Pressure (hPa)
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCV !Temperature and cloud variable
- !on full-level model
-REAL, DIMENSION(:), ALLOCATABLE :: ZANGL !Satellite zenith angle (deg)
-REAL, DIMENSION(:), ALLOCATABLE :: ZANGS !Solar zenith angle (deg)
-! -----------------------------------------------------------------------------
-! Jacobian fields
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTEMPK, ZWVAPK
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTEMPKP, ZTEMPKPP, ZWVAPKP, ZWVAPKPP
-! -----------------------------------------------------------------------------
-! INDEXES AND TEMPORAL ARRAYS FOR VECTORIZATION
-INTEGER :: JIS, IBEG, IEND, IDIM, ICPT
-INTEGER, DIMENSION(:), ALLOCATABLE :: IMSURFP
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZAVP, ZCVP
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZSAVP, ZSSVP, ZAPP, ZAP_HLP
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZZTMP, ZZTMPP
-REAL, DIMENSION(:), ALLOCATABLE :: ZANGLP, ZREMISP
-LOGICAL, DIMENSION(:), ALLOCATABLE :: GANGL
-! -----------------------------------------------------------------------------
-INTEGER :: INRAD = 2 ! INRAD=1 RADIANCE; INRAD=2 BRIGHTNESS TEMPERATURE
-! -----------------------------------------------------------------------------
-! Realistic maximum values for hydrometeor content in kg/kg
-REAL :: ZRCMAX = 5.0E-03, ZRRMAX = 5.0E-03, ZRIMAX = 2.0E-03, ZRSMAX = 5.0E-03
-! -----------------------------------------------------------------------------
-INTEGER, DIMENSION(:), ALLOCATABLE :: IMSURF !Surface type index
-
-INTEGER :: IKFBOT, IKFTOP, INDEX, ISUM, JLEV, JCH, IWATER, ICAN
-REAL, DIMENSION(:), ALLOCATABLE :: ZTEXTR, ZQVEXTR !Array used in interpolation
-REAL, DIMENSION(:), ALLOCATABLE :: ZQVSAT, ZVINT !Array used in interpolation
-REAL, DIMENSION(:), ALLOCATABLE :: ZPSUM, ZTSUM, ZQVSUM, ZO3SUM !Array used in interpolation
-REAL :: zconst, ZPS, ZTGRAD, ZQGRAD, ZOGRAD !variables used in interpolation
-REAL, DIMENSION(:), ALLOCATABLE :: ZPIN, ZFIN, ZOUT
-! at the open of the file LFI routines
-CHARACTER(LEN=8) :: YINST
-CHARACTER(LEN=4) :: YBEG, YEND
-CHARACTER(LEN=2) :: YCHAN, YTWO
-CHARACTER(LEN=1) :: YONE
-
-INTEGER, PARAMETER :: JPPLAT=16
-
-CHARACTER(LEN=3), DIMENSION(JPPLAT) :: YPLAT= (/ &
- 'N ','D ','MET','GO ','GMS','FY2','TRM','ERS', &
- 'EOS','MTP','ENV','MSG','FY1','ADS','MTS','CRL' /)
-CHARACTER(LEN=2), DIMENSION(2) :: YLBL_MVIRI = (/ 'WV', 'IR'/)
-CHARACTER(LEN=3), DIMENSION(7) :: YLBL_SSMI = (/ &
- '19V','19H','22V','37V','37H','85V','85H'/)
-CHARACTER(LEN=3), DIMENSION(9) :: YLBL_TMI = (/ &
- '10V','10H','19V','19H','22V','37V','37H','85V','85H'/)
-CHARACTER(LEN=3), DIMENSION(8) :: YLBL_SEVIRI = (/ &
- '039', '062','073','087','097','108','120','134'/)
-CHARACTER(LEN=3), DIMENSION(4) :: YLBL_GOESI = (/ &
- '039', '067','107','120'/)
-
-! -----------------------------------------------------------------------------
-!*JPC*VECTORIZATION
-!! One profile per run
-!! INTEGER (Kind=jpim) :: nprofiles = 1
-INTEGER (Kind=jpim) :: nprofiles, ntruepro
-!*JPC*VECTORIZATION
-
-! RTTOV_readcoeffs interface
-! ====================
-INTEGER(Kind=jpim) :: errorstatus
-INTEGER(Kind=jpim) :: instrument(3)
-TYPE( rttov_coef ) :: coef ! coefficients
-TYPE( rttov_scatt_coef ) :: coef_scatt
-
-! RTTOV interface
-! ====================
-INTEGER(Kind=jpim), ALLOCATABLE :: rttov_errorstatus(:) ! rttov error return code
-INTEGER(Kind=jpim) :: nfrequencies
-INTEGER(Kind=jpim) :: nchannels
-INTEGER(Kind=jpim) :: nbtout
-INTEGER(Kind=jpim), ALLOCATABLE :: channels (:), n_chan(:)
-INTEGER(Kind=jpim), ALLOCATABLE :: polarisations (:,:)
-INTEGER(Kind=jpim), ALLOCATABLE :: frequencies (:)
-INTEGER(Kind=jpim), ALLOCATABLE :: lprofiles (:),lsprofiles(:),lsprofiles2(:)
-TYPE(profile_Type), ALLOCATABLE :: profiles(:)
-TYPE(profile_cloud_type), ALLOCATABLE :: cld_profiles(:)
-TYPE(transmission_type) :: transmission
-LOGICAL :: addcloud = .FALSE.
-LOGICAL, ALLOCATABLE :: calcemis(:)
-REAL(Kind=jprb), ALLOCATABLE :: emissivity (:)
-TYPE(radiance_cloud_type) :: radiance
-
-REAL(Kind=jprb), ALLOCATABLE :: input_emissivity (:)
-CHARACTER (len=6) :: NameOfRoutine = 'tstrad'
-! RTTOV K/AD interface
-! ====================
-LOGICAL :: switchrad ! true if input is BT
-TYPE(profile_Type), ALLOCATABLE :: profiles_k(:)
-TYPE(profile_cloud_Type), ALLOCATABLE :: cld_profiles_k(:)
-REAL(Kind=jprb), ALLOCATABLE :: emissivity_k (:)
-
-! variables for input
-! ====================
-! Parameter for WV conversion used in all tstrad suite
-REAL(Kind=jprb), PARAMETER :: q_mixratio_to_ppmv = 1.60771704e+6_JPRB
-REAL(Kind=jprb), PARAMETER :: o3_mixratio_to_ppmv = 6.03504e+5_JPRB
-INTEGER(Kind=jpim) :: alloc_status(40)
-
-CHARACTER(LEN=:), ALLOCATABLE :: YMNHNAME, YUNITS, YCOMMENT
-TYPE(TFIELDMETADATA) :: TZFIELD
-
-! - End of header --------------------------------------------------------
-!!!----------------------------------------------------------------------------
-!!!
-!!!* 1. INITIALIZATION OF CONSTANTS FOR TRANSFERT CODE
-!!! ----------------------------------------------
-!!!
-
-! JPC from refprof.dat
-ZPRES=(/ 0.100, 0.290, 0.690, 1.420, 2.611, 4.407, &
- 6.950, 10.370, 14.810, 20.400, 27.260, 35.510, &
- 45.290, 56.730, 69.970, 85.180, 102.050, 122.040, &
- 143.840, 167.950, 194.360, 222.940, 253.710, 286.600, &
- 321.500, 358.280, 396.810, 436.950, 478.540, 521.460, &
- 565.540, 610.600, 656.430, 702.730, 749.120, 795.090, &
- 839.950, 882.800, 922.460, 957.440, 985.880, 1005.430, &
- 1013.250 /)
-
-DO JK=1,JPLEV
- JKRAD=JPLEV-JK+1
- ZPRES_INV(JK)=ZPRES(JKRAD)*100. ! Conversion from hPa to Pa
-END DO
-
-errorstatus = 0
-alloc_status(:) = 0
-
-PRINT *,'NB OF SAT SIZE(KRTTOVINFO,1)=',SIZE(KRTTOVINFO,1)
-PRINT *,'NB OF SAT SIZE(KRTTOVINFO,2)=',SIZE(KRTTOVINFO,2)
-DO JSAT=1,SIZE(KRTTOVINFO,2)
- IF (KRTTOVINFO(1,JSAT) /= NUNDEF) THEN
- IJSAT = JSAT
- END IF
-END DO
-
-JSAT=1
-instrument(1)=KRTTOVINFO(1,JSAT)
-instrument(2)=KRTTOVINFO(2,JSAT)
-instrument(3)=KRTTOVINFO(3,JSAT)
-PRINT *,'range(KRTTOVINFO(3,JSAT)) ',range(KRTTOVINFO(3,JSAT))
-PRINT *,'range(instrument(3)) ',range(instrument(3))
-CALL rttov_readcoeffs (errorstatus, coef, instrument)
-CALL rttov_initcoeffs (errorstatus, coef)
-
-switchrad = INRAD == 2
-PRINT *,' RADIANCE OR TB CALCULATION: INRAD=',INRAD,' switchrad=',switchrad
-
-!!!----------------------------------------------------------------------------
-!!!
-!!!* 2. COMPUTE DIMENSIONS OF ARRAYS AND OTHER INDICES
-!!! ----------------------------------------------
-
-IIU = SIZE(PTHT,1)
-IJU = SIZE(PTHT,2)
-IKU = SIZE(PTHT,3)
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-IKB = 1 + JPVEXT
-IKE = IKU - JPVEXT
-IKR = IKE - IKB +1
-
-IKSTAE = SIZE(PSTATM,1)
-IKUP = IKE-JPVEXT+1
-
-!*JPC*VECTORIZATION
-! Determine the number of profiles per RTTOV run
-nprofiles = JPPF
-!*JPC*VECTORIZATION
-
-
-!!!----------------------------------------------------------------------------
-!!!
-!!!* 3. INITIALIZES THE MEAN-LAYER VARIABLES
-!!! ------------------------------------
-
-ALLOCATE(ZEXNT(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
-ZEXNT(:,:,:)= ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
-
-! Pressure
-ALLOCATE(ZPAVE(KDLON,KFLEV))
-DO JK=IKB,IKE
- JKRAD = JK-JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = (JI-JPHEXT) + (IIE-IIB+1)*(JJ-IJB)
- ZPAVE(IIJ,JKRAD) = PPABST(JI,JJ,JK)*0.01 !Pressure in hPa
- END DO
- END DO
-END DO
-
-! Temperature
-ALLOCATE(ZTEMP(IIU,IJU,IKU))
-ZTEMP=PTHT*ZEXNT
-ALLOCATE(ZTAVE(KDLON,KFLEV))
-DO JK=IKB,IKE
- JKRAD = JK-JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = (JI-JPHEXT) + (IIE-IIB+1)*(JJ-IJB)
- ZTAVE(IIJ,JKRAD) = ZTEMP(JI,JJ,JK)
- END DO
- END DO
-END DO
-
-! Water vapor
-ALLOCATE(ZQVAVE(KDLON,KFLEV))
-ZQVAVE(:,:) = 0.0
-IF( SIZE(PRT(:,:,:,:),4) >= 1 ) THEN
- DO JK=IKB,IKE
- JKRAD = JK-JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = (JI-JPHEXT) + (IIE-IIB+1)*(JJ-IJB)
- ZQVAVE(IIJ,JKRAD) = PRT(JI,JJ,JK,1)
- END DO
- END DO
- END DO
-END IF
-
-! Ozone
-ALLOCATE(ZO3AVE(KDLON,KFLEV))
-
-ZSTAOZ(:) = PSTATM(:,6)/PSTATM(:,4)
-ZSTAZZ(:) = 1000.0*PSTATM(:,1)
-
-DO JJ = IJB,IJE
- DO JK2 = IKB,IKE
- JKRAD = JK2-JPVEXT
- IKKOZ(:,JK2) = IKB-1
- DO JK1 = 1,IKSTAE
- DO JI = IIB,IIE
- IKKOZ(JI,JK2)=IKKOZ(JI,JK2) + NINT(0.5 + SIGN(0.5, &
- -ZSTAZZ(JK1)+0.5*(PZZ(JI,JJ,JK2)+PZZ(JI,JJ,JK2+1)) ))
- END DO
- END DO
- DO JI = IIB,IIE
- ZOZ=(0.5*(PZZ(JI,JJ,JK2)+PZZ(JI,JJ,JK2+1))- ZSTAZZ(IKKOZ(JI,JK2))) &
- /( ZSTAZZ(IKKOZ(JI,JK2)+1) - ZSTAZZ(IKKOZ(JI,JK2)))
- IIJ = (JI-JPHEXT) + (IIE-IIB+1)*(JJ-IJB)
- ZO3AVE(IIJ,JKRAD) =( (1.- ZOZ) * ZSTAOZ(IKKOZ(JI,JK2)) &
- + ZOZ * ZSTAOZ(IKKOZ(JI,JK2)+1))
- END DO
- END DO
-END DO
-
-! Standard atmosphere extension
-DO JK=IKUP,KFLEV
- JK1 = (KSTATM-1)+(JK-IKUP)
- JK2 = JK1+1
- ZPAVE(:,JK) = 0.5*( PSTATM(JK1,2)+PSTATM(JK2,2) )
- ZTAVE(:,JK) = 0.5*( PSTATM(JK1,3)+PSTATM(JK2,3) )
- ZQVAVE(:,JK) = 0.5*( PSTATM(JK1,5)/PSTATM(JK1,4)+PSTATM(JK2,5)/PSTATM(JK2,4))
- JK1 = (KSTATM)+(JK-IKUP)
- ZO3AVE(:,JK) = ZSTAOZ(JK1)
-END DO
-!!!
-!!!----------------------------------------------------------------------------
-!!!
-!!!* 4. INTERPOLATES THE ATMOSPHERIC VARIABLES ONTO THE RTTOV GRID
-! ----------------------------------------------------------
-!!!WITH INVERSION OF VERTICAL LEVELS!
-
-ALLOCATE(ZAV(JPLEV,JPNAV,KDLON))
-
-ALLOCATE(ZTEXTR(JPLEV))
-ALLOCATE(ZQVEXTR(JPLEV))
-ALLOCATE(ZVINT(JPLEV))
-ISUM=JPLEV+KFLEV
-ALLOCATE(ZPSUM(ISUM))
-ALLOCATE(ZTSUM(ISUM))
-ALLOCATE(ZQVSUM(ISUM))
-ALLOCATE(ZO3SUM(ISUM))
-ALLOCATE(ZQVSAT(ISUM))
-ZPSUM(:)=0.
-ZTSUM(:)=0.
-ZQVSUM(:)=0.
-ZO3SUM(:)=0.
-ZQVSAT(:)=0.
-zconst= 287./1005.
-IWATER = coef % fmv_gas_pos( gas_id_watervapour )
-DO JI=IIB,IIE
- DO JJ=IJB,IJE
- IIJ = (JI-JPHEXT) + (IIE-IIB+1)*(JJ-IJB)
- ZPS=XP00*0.01 * & !Surface Pressure in hPa
- (0.5*(ZEXNT(JI,JJ,IKB)+ZEXNT(JI,JJ,IKB-1)))**(XCPD/XRD)
- DO JK=1,KFLEV
- JKRAD = KFLEV-JK+1 !INVERSION OF VERTICAL LEVELS!
- ZPSUM(JKRAD)=ZPAVE(IIJ,JK)
- ZTSUM(JKRAD)=ZTAVE(IIJ,JK)
- ZQVSUM(JKRAD)=ZQVAVE(IIJ,JK)
- ZO3SUM(JKRAD)=ZO3AVE(IIJ,JK)
- END DO
- ZTSUM(KFLEV+1)=ZTAVE(IIJ,1)
- ZQVSUM(KFLEV+1)=ZQVAVE(IIJ,1)
- IKFBOT=0
- DO JKF=1,JPLEV
- IF (ZPRES(JKF) > ZPS) THEN
- IKFBOT=JKF
- EXIT
- END IF
- END DO
- INDEX = KFLEV
- IF (IKFBOT /= 0) THEN
-!!!-----Extrapolates temperature below surface pressure-------------------
- INDEX=JPLEV-IKFBOT+1
- INDEX=INDEX+KFLEV+1
- ZTSUM((KFLEV+2):INDEX) = PTSRAD(JI,JJ)
- ZPSUM((KFLEV+1))=ZPS
- ZPSUM((KFLEV+2):INDEX)=ZPRES(IKFBOT:JPLEV)
- ZO3SUM((KFLEV+2):INDEX)=ZO3AVE(IIJ,1)
- END IF
-!!!-----Extrapolates profile above highest declared level-----------------
-!!!----- => linear extrapolation -----------------------------------------
- IKFTOP = 1
- DO JLEV=1,INDEX
- IF(ZPRES(JLEV) >= ZPAVE(IIJ,KFLEV) ) EXIT
- IKFTOP = IKFTOP + 1
- END DO
- IF (IKFTOP /= 1) THEN
- ZTGRAD = (ZTSUM(1) - ZTSUM(2)) / (ZPSUM(1)-ZPSUM(2))
- ZQGRAD = (ZQVSUM(1) - ZQVSUM(2)) / (ZPSUM(1)-ZPSUM(2))
- ZOGRAD = (ZO3SUM(1) - ZO3SUM(2)) / (ZPSUM(1)-ZPSUM(2))
- DO JLEV=INDEX, 1, -1
- ZTSUM(JLEV+IKFTOP-1) = ZTSUM(JLEV)
- ZQVSUM(JLEV+IKFTOP-1) = ZQVSUM(JLEV)
- ZO3SUM(JLEV+IKFTOP-1) = ZO3SUM(JLEV)
- ZPSUM(JLEV+IKFTOP-1) = ZPSUM(JLEV)
- END DO
- INDEX = INDEX + IKFTOP-1
- DO JLEV=1,IKFTOP-1
- ZPSUM(JLEV) = ZPRES(JLEV)
- ZTSUM(JLEV) = ZTSUM(IKFTOP) &
- + ZTGRAD * (ZPSUM(JLEV) - ZPSUM(IKFTOP))
- ZQVSUM(JLEV) = ZQVSUM(IKFTOP) &
- + ZQGRAD * (ZPSUM(JLEV) - ZPSUM(IKFTOP))
- ZO3SUM(JLEV) = ZO3SUM(IKFTOP) &
- + ZOGRAD * (ZPSUM(JLEV) - ZPSUM(IKFTOP))
- END DO
- ENDIF
-!!!-----Interpolates to given pressure grid-------------------------------
- ALLOCATE(ZPIN(INDEX))
- ALLOCATE(ZFIN(INDEX))
- ALLOCATE(ZOUT(JPLEV))
- DO JLEV=1,INDEX
- JKRAD=INDEX-JLEV+1
- ZPIN(JKRAD) = ZPSUM(JLEV)*100.
- ZFIN(JKRAD) = ZTSUM(JLEV)
- END DO
- CALL PINTER(ZFIN, ZPIN, ZFIN, ZFIN, ZOUT, ZPRES_INV, &
- 1, 1, INDEX, 1, JPLEV, 'LOG', 'RHU.')
- DO JLEV=1,JPLEV
- JKRAD=JPLEV-JLEV+1
- ZVINT(JKRAD) = ZOUT(JLEV)
- END DO
- ZAV(:,1,IIJ)= ZVINT(:) ! temperature K
- DO JLEV=1,INDEX
- JKRAD=INDEX-JLEV+1
- ZFIN(JKRAD) = ZQVSUM(JLEV)
- END DO
- CALL PINTER(ZFIN, ZPIN, ZFIN, ZFIN, ZOUT, ZPRES_INV, &
- 1, 1, INDEX, 1, JPLEV, 'LOG', 'RHU.')
- DO JLEV=1,JPLEV
- JKRAD=JPLEV-JLEV+1
- ZVINT(JKRAD) = ZOUT(JLEV)
- END DO
- ZAV(:,2,IIJ)= ZVINT(:)*q_mixratio_to_ppmv ! water vapor mr ppmv
- DO JLEV=1,INDEX
- JKRAD=INDEX-JLEV+1
- ZFIN(JKRAD) = ZO3SUM(JLEV)
- END DO
- CALL PINTER(ZFIN, ZPIN, ZFIN, ZFIN, ZOUT, ZPRES_INV, &
- 1, 1, INDEX, 1, JPLEV, 'LOG', 'RHU.')
- DO JLEV=1,JPLEV
- JKRAD=JPLEV-JLEV+1
- ZVINT(JKRAD) = ZOUT(JLEV)
- END DO
- ZAV(:,3,IIJ)= ZVINT(:)*o3_mixratio_to_ppmv ! ozone mixing ratio ppmv
- DO JLEV=1,JPLEV
- ZAV(JLEV,1,IIJ)= MAX(coef%lim_prfl_tmin(JLEV), &
- MIN(coef%lim_prfl_tmax(JLEV),ZAV(JLEV,1,IIJ)))
- ZAV(JLEV,2,IIJ)= MAX(coef%lim_prfl_gmin(JLEV,IWATER), &
- MIN(coef%lim_prfl_gmax(JLEV,IWATER),ZAV(JLEV,2,IIJ)))
- END DO
- DEALLOCATE(ZPIN,ZFIN,ZOUT)
- END DO
-END DO
-DEALLOCATE(ZVINT)
-DEALLOCATE(ZPAVE,ZTAVE,ZQVAVE,ZO3AVE)
-!
-!--------------------------------------------------------------------------
-!
-!* 6. CALLS THE RTTOV RADIATION CODE
-! ------------------------------
-!
-!* 6.1 INITIALIZES 2D AND SURFACE FIELDS
-!
-!
-ALLOCATE(ZANGS(KDLON))
-ZANGS(:)=0. ! zenithal solar angle not used
-!
-ALLOCATE(IMSURF(KDLON))
-DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = (JI-JPHEXT) + (IIE-IIB+1)*(JJ-IJB)
- IMSURF(IIJ) = NINT(XSEA(JI,JJ)) ! Surface Mask 0=land, 1=sea, 2=sea-ice
- END DO
-END DO
-!
-ALLOCATE(ZSAV(JPNSAV,KDLON)) ! Surface 2m array contents
-! fields taken at first level rather than at 2m
-DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = (JI-JPHEXT) + (IIE-IIB+1)*(JJ-IJB)
- ZSAV(1,IIJ) = ZTEMP(JI,JJ,IKB) ! 2m temperature (K)
- ZSAV(2,IIJ) = PRT(JI,JJ,IKB,1)*q_mixratio_to_ppmv ! 2m water vapor (ppmv)
- ZSAV(3,IIJ) = XP00*0.01 * & !Surface Pressure in hPa
- (0.5*(ZEXNT(JI,JJ,IKB)+ZEXNT(JI,JJ,IKB-1)))**(XCPD/XRD)
- ZSAV(4,IIJ) = PULVLKB(JI,JJ) ! 2m wind speed u (m/s)
- ZSAV(5,IIJ) = PVLVLKB(JI,JJ) ! 2m wind speed v (m/s)
- END DO
-END DO
-!
-ALLOCATE(ZSSV(JPNSSV,KDLON)) !Surface skin array contents
-DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = (JI-JPHEXT) + (IIE-IIB+1)*(JJ-IJB)
- ZSSV(1,IIJ) = PTSRAD(JI,JJ)
- ZSSV(2,IIJ) = 2.3 ! FASTEM-2 land coef (Bare soil see Table 3 svr)
- ZSSV(3,IIJ) = 1.9 ! FASTEM-2 land coef
- ZSSV(4,IIJ) = 21.8 ! FASTEM-2 land coef
- ZSSV(5,IIJ) = 0.0 ! FASTEM-2 land coef
- ZSSV(6,IIJ) = 0.5 ! FASTEM-2 land coef
- END DO
-END DO
-!
-!
-ALLOCATE(ZAP(KDLON,IKR))
-DO JK=IKB,IKE
- JKRAD = IKE-JK+1 !INVERSION OF VERTICAL LEVELS!
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = (JI-JPHEXT) + (IIE-IIB+1)*(JJ-IJB)
- ZAP(IIJ,JKRAD)=PPABST(JI,JJ,JK)*0.01 !Pressure in hPa
- END DO
- END DO
-END DO
-!
-!
-ALLOCATE(ZAP_HL(KDLON,IKR+1))
-DO JK=IKB,IKE+1
- JKRAD = IKE-JK+2 !INVERSION OF VERTICAL LEVELS!
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = (JI-JPHEXT) + (IIE-IIB+1)*(JJ-IJB)
- ZAP_HL(IIJ,JKRAD)=XP00*0.01 * & !Pressure in hPa
- (0.5*(ZEXNT(JI,JJ,JK)+ZEXNT(JI,JJ,JK-1)))**(XCPD/XRD)
- END DO
- END DO
-END DO
-DEALLOCATE(ZEXNT)
-!
-!
-ALLOCATE(ZNCLD(IIU,IJU,IKU))
-ZNCLD=0.
-ALLOCATE(ZRC(IIU,IJU,IKU))
-ZRC=0.
-ALLOCATE(ZRI(IIU,IJU,IKU))
-ZRI=0.
-ALLOCATE(ZRR(IIU,IJU,IKU))
-ZRR=0.
-ALLOCATE(ZRS(IIU,IJU,IKU))
-ZRS=0.
-IF( SIZE(PRT(:,:,:,:),4) >= 3 ) THEN
- ZRC=PRT(:,:,:,2)
- ZRR=PRT(:,:,:,3)
- IF( OUSERI ) THEN
-! ice
- ZRI=PRT(:,:,:,4)
- ZRS=PRT(:,:,:,5)+PRT(:,:,:,6)
- END IF
- ZNCLD=PCLDFR
-END IF
-
-! temperature and cloud field on full-model levels
-ALLOCATE(ZCV(KDLON,IKR,JPNCVCLD))
-ZCV = 0.
-
-DO JK=IKB,IKE
- JKRAD = IKE-JK+1 !INVERSION OF VERTICAL LEVELS!
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = (JI-JPHEXT) + (IIE-IIB+1)*(JJ-IJB)
- ZCV(IIJ,JKRAD,1)=ZTEMP(JI,JJ,JK) !Temperature (K)
- ZCV(IIJ,JKRAD,2)=ZNCLD(JI,JJ,JK) !Cloud cover (fraction)
- ZCV(IIJ,JKRAD,3)=MIN(ZRCMAX,ZRC(JI,JJ,JK)) !Cloud liquid water (kg/kg)
- ZCV(IIJ,JKRAD,4)=MIN(ZRIMAX,ZRI(JI,JJ,JK)) !Cloud ice water (kg/kg)
-! rttov_iniscatt modified
-! ZCV(IIJ,JKRAD,5)=ZRR(JI,JJ,JK) !rain (kg/m2/s)
-! ZCV(IIJ,JKRAD,6)=ZRS(JI,JJ,JK) !solid precipitation (kg/m2/s)
- ZCV(IIJ,JKRAD,5)=MIN(ZRRMAX,ZRR(JI,JJ,JK)) !rain (kg/kg)
- ZCV(IIJ,JKRAD,6)=MIN(ZRSMAX,ZRS(JI,JJ,JK)) !solid precipitation (kg/kg)
- END DO
- END DO
-END DO
-DEALLOCATE(ZTEMP,ZNCLD,ZRC,ZRI,ZRR,ZRS)
-!
-!
-ALLOCATE(ZREMIS(KDLON))
-DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = (JI-JPHEXT) + (IIE-IIB+1)*(JJ-IJB)
- ZREMIS(IIJ) = PEMIS(JI,JJ)
- END DO
-END DO
-!
-ALLOCATE(ZULAT(KDLON))
-ALLOCATE(ZULON(KDLON))
-DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = (JI-JPHEXT) + (IIE-IIB+1)*(JJ-IJB)
- ZULON(IIJ) = XLON(JI,JJ)
- ZULAT(IIJ) = XLAT(JI,JJ)
- END DO
-END DO
-!
-!* 6.2 CALLS THE RTTOV ROUTINES
-!
-!
-ALLOCATE( rttov_errorstatus(nprofiles))
-
-! Profiles on RTTOV pressure levels
-ALLOCATE( profiles(nprofiles))
-DO JI = 1, nprofiles
-! allocate model profiles atmospheric arrays with model levels dimension
- profiles(JI) % nlevels = coef % nlevels
- ALLOCATE( profiles(JI) % p ( coef % nlevels ) )
- ALLOCATE( profiles(JI) % t ( coef % nlevels ) )
- ALLOCATE( profiles(JI) % q ( coef % nlevels ) )
- ALLOCATE( profiles(JI) % o3 ( coef % nlevels ) )
- ALLOCATE( profiles(JI) % clw( coef % nlevels ) )
- profiles(JI) % p(:) = coef % ref_prfl_p(:)
-END DO
-! Cloud additional profiles
-ALLOCATE( cld_profiles(nprofiles))
-DO JI = 1, nprofiles
-! allocate model profiles atmospheric arrays with model levels dimension
- cld_profiles(JI) % nlevels = IKR
- ALLOCATE( cld_profiles(JI) % p ( IKR ) )
- ALLOCATE( cld_profiles(JI) % ph ( IKR+1 ) )
- ALLOCATE( cld_profiles(JI) % t ( IKR ) )
- ALLOCATE( cld_profiles(JI) % cc ( IKR ) )
- ALLOCATE( cld_profiles(JI) % clw( IKR ) )
- ALLOCATE( cld_profiles(JI) % ciw( IKR ) )
- ALLOCATE( cld_profiles(JI) % rain( IKR ) )
- ALLOCATE( cld_profiles(JI) % sp( IKR ) )
-END DO
-
-! -----------------------------------------------------------------------------
-! *** LOOP OVER SENSORS ***
-! -----------------------------------------------------------------------------
-DO JSAT=1,IJSAT ! loop over sensors
-
- instrument(1)=KRTTOVINFO(1,JSAT)
- instrument(2)=KRTTOVINFO(2,JSAT)
- instrument(3)=KRTTOVINFO(3,JSAT)
- PRINT *,' JSAT=',JSAT, instrument
-
-! Read and initialise coefficients
-! -----------------------------------------------------------------------------
- CALL rttov_readcoeffs (errorstatus, coef, instrument)
- IF(errorstatus /= 0) THEN
- WRITE(*,*) 'error rttov_readcoeffs :',errorstatus
-!callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','CALL_RTTOV8','error rttov_readcoeffs')
- ENDIF
- CALL rttov_initcoeffs (errorstatus,coef)
- IF(errorstatus /= 0) THEN
- WRITE(*,*) 'error rttov_initcoeffs :',errorstatus
-!callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','CALL_RTTOV8','error rttov_initcoeffs')
- ENDIF
-
- ! Read coef file for cloud/rain absorption/scattering
- IF( coef% id_sensor == sensor_id_mw) THEN
- CALL rttov_readscattcoeffs (errorstatus, coef, coef_scatt)
- ENDIF
-
- ALLOCATE(ZANGL(KDLON))
- ZANGL=XUNDEF
- IF (KRTTOVINFO(1,JSAT) == 1) THEN ! NOAA PLATFORM
- ZANGL=0.
- ELSEIF (KRTTOVINFO(1,JSAT) == 2) THEN ! DMSP PLATFORM
- ZANGL=53.1 ! see Saunders, 2002, RTTOV7 - science/validation rep, page 8
-! METEOSAT PLATFORM
- ELSEIF (KRTTOVINFO(1,JSAT) == 3) THEN
- CALL DETER_ANGLE(5, KDLON, ZULAT, ZULON, ZANGL)
-! Conversion from cosecant to angle (deg)
- WHERE (ZANGL /= XUNDEF .AND. ZANGL /=0.) ZANGL=ACOS(1./ZANGL)*180./XPI
-! MSG PLATFORM
- ELSEIF (KRTTOVINFO(1,JSAT) == 12) THEN
- CALL DETER_ANGLE(6, KDLON, ZULAT, ZULON, ZANGL)
-! Conversion from cosecant to angle (deg)
- WHERE (ZANGL /= XUNDEF .AND. ZANGL /=0.) ZANGL=ACOS(1./ZANGL)*180./XPI
- ELSEIF (KRTTOVINFO(1,JSAT) == 4) THEN ! GOES-E PLATFORM
- CALL DETER_ANGLE(1, KDLON, ZULAT, ZULON, ZANGL)
-! Conversion from cosecant to angle (deg)
- WHERE (ZANGL /= XUNDEF .AND. ZANGL /=0.) ZANGL=ACOS(1./ZANGL)*180./XPI
- ELSEIF (KRTTOVINFO(1,JSAT) == 7) THEN ! TRMM PLATFORM
- ZANGL=52.3 ! see Kummerow et al., J. Appl. Meteorol., Dec. 2000
- ENDIF
-! Coefficients computed from transmittances for 6 viewing angles in the range
-! 0 to 63.6 deg (Saunders, 2002, RTTOV7 - science/validation rep., page 3)
- WHERE (ZANGL > 65.) ZANGL=65.
-
- ALLOCATE(n_chan(nprofiles))
- n_chan=coef%fmv_chn
- CALL rttov_setupchan(nprofiles,n_chan,coef,nfrequencies,nchannels,nbtout)
-
- ALLOCATE( channels ( nfrequencies ) )
- ALLOCATE( lprofiles ( nfrequencies ) )
- ALLOCATE( lsprofiles ( nchannels ) )
- ALLOCATE( lsprofiles2 ( nbtout ) )
- ALLOCATE( emissivity ( nchannels ) )
- ALLOCATE( frequencies ( nchannels ) )
- ALLOCATE( polarisations ( nchannels ,3) )
- ALLOCATE( input_emissivity ( nchannels ) )
- ALLOCATE( calcemis ( nchannels ) )
-
- ALLOCATE( transmission % tau_surf ( nchannels ) )
- ALLOCATE( transmission % tau_layer ( coef % nlevels, nchannels ) )
- ALLOCATE( transmission % od_singlelayer( coef % nlevels, nchannels ) )
-
- calcemis(1:nchannels) = .TRUE.
- input_emissivity(1:nchannels) = 0.5
- emissivity(1:nchannels) = 0.
-
-! allocate radiance results arrays with number of channels
- ALLOCATE( radiance % clear ( nchannels ) )
- ALLOCATE( radiance % cloudy ( nchannels ) )
- ALLOCATE( radiance % total ( nchannels ) )
- ALLOCATE( radiance % bt ( nchannels ) )
- ALLOCATE( radiance % bt_clear ( nchannels ) )
- ALLOCATE( radiance % upclear ( nchannels ) )
- ALLOCATE( radiance % dnclear ( nchannels ) )
- ALLOCATE( radiance % reflclear( nchannels ) )
- ALLOCATE( radiance % overcast ( IKR, nchannels ) )
- ALLOCATE( radiance % downcld ( IKR, nchannels ) )
- ALLOCATE( radiance % cldemis ( IKR, nchannels ) )
- ALLOCATE( radiance % wtoa ( IKR, nchannels ) )
- ALLOCATE( radiance % wsurf ( IKR, nchannels ) )
- ALLOCATE( radiance % cs_wtoa ( nchannels ) )
- ALLOCATE( radiance % cs_wsurf ( nchannels ) )
- ALLOCATE( radiance % out ( nbtout ) )
- ALLOCATE( radiance % out_clear( nbtout ) )
- ALLOCATE( radiance % total_out( nbtout ) )
- ALLOCATE( radiance % clear_out( nbtout ) )
- ALLOCATE( radiance % freq_used( nchannels) )
-
-! Allocate new profiles for K code
- IF ( KRTTOVINFO(4,JSAT) == 1 .OR. KRTTOVINFO(4,JSAT) == 3) THEN
-! Profiles on RTTOV pressure levels
- ALLOCATE( profiles_k(nchannels))
- DO JI = 1, nchannels
-! allocate model profiles atmospheric arrays with model levels dimension
- profiles_k(JI) % nlevels = coef % nlevels
- ALLOCATE( profiles_k(JI) % p ( coef % nlevels ) )
- ALLOCATE( profiles_k(JI) % t ( coef % nlevels ) )
- ALLOCATE( profiles_k(JI) % q ( coef % nlevels ) )
- ALLOCATE( profiles_k(JI) % o3 ( coef % nlevels ) )
- ALLOCATE( profiles_k(JI) % clw( coef % nlevels ) )
- profiles_k(JI) % p(:) = coef % ref_prfl_p(:)
- END DO
-! Cloud additional profiles
- ALLOCATE( cld_profiles_k(nchannels))
- DO JI = 1, nchannels
-! allocate model profiles atmospheric arrays with model levels dimension
- cld_profiles_k(JI) % nlevels = IKR
- ALLOCATE( cld_profiles_k(JI) % p ( IKR ) )
- ALLOCATE( cld_profiles_k(JI) % ph ( IKR+1 ) )
- ALLOCATE( cld_profiles_k(JI) % t ( IKR ) )
- ALLOCATE( cld_profiles_k(JI) % cc ( IKR ) )
- ALLOCATE( cld_profiles_k(JI) % clw( IKR ) )
- ALLOCATE( cld_profiles_k(JI) % ciw( IKR ) )
- END DO
- ALLOCATE( emissivity_k( nchannels ))
- END IF
-
-
-! fixed values
- profiles(1:nprofiles) % ozone_data = .TRUE.
- profiles(1:nprofiles) % co2_data = .FALSE.
- profiles(1:nprofiles) % clw_data = .FALSE.
- profiles(1:nprofiles) % s2m % o = 0.
- profiles(1:nprofiles) % azangle = 0. !!!!!! WARNING
- profiles(1:nprofiles) % ctp = 500._JPRB ! default value
- profiles(1:nprofiles) % cfraction = 0._JPRB ! default value
-! See rttov_emiscld.F90
- cld_profiles(1:nprofiles) % kice = 0 ! Hexagonal columns
-! cld_profiles(1:nprofiles) % kice = 1 ! Aggregates
-! cld_profiles(1:nprofiles) % kradip = 0 ! Ou-Liou
-! cld_profiles(1:nprofiles) % kradip = 1 ! Wyser
-! cld_profiles(1:nprofiles) % kradip = 2 ! Boudala et al.
- cld_profiles(1:nprofiles) % kradip = 3 ! McFarquhar
-
- PRINT *,'cld_profiles % kice = ',cld_profiles(1) % kice
- PRINT *,'cld_profiles % kradip = ',cld_profiles(1) % kradip
-
- CALL rttov_setupindex (n_chan,nprofiles,nfrequencies,nchannels,nbtout,coef, &
- & input_emissivity,lprofiles,channels,polarisations,emissivity)
-
-!!! Set up remaining indices
- IF( coef% id_sensor == sensor_id_mw) &
- CALL rttov_scatt_setupindex (nprofiles,n_chan,coef,nchannels, &
- & lsprofiles, lsprofiles2, frequencies,nbtout)
-
-!!! METEOSAT, GOES, OR MSG PLATFORM
- IF (KRTTOVINFO(1,JSAT) == 3 .OR. KRTTOVINFO(1,JSAT) == 4 &
- .OR. KRTTOVINFO(1,JSAT) == 12) &
- calcemis(1:nchannels) = .FALSE.
-
-
- ALLOCATE(GANGL(KDLON))
- GANGL(:) = .TRUE.
- WHERE( ZANGL(:) == XUNDEF)
- GANGL(:) = .FALSE.
- END WHERE
-
- IDIM = COUNT( GANGL(:) ) ! number of columns with a defined sat angle
-
- ALLOCATE(ZANGLP(IDIM))
- ZANGLP = PACK( ZANGL,MASK=GANGL )
-
- ALLOCATE(ZAVP(JPLEV,JPNAV,IDIM))
- DO JC=1,JPNAV
- DO JK=1,JPLEV
- ZAVP(JK,JC,:) = PACK( ZAV(JK,JC,:),MASK=GANGL )
- END DO
- END DO
-
- ALLOCATE(ZSAVP(JPNSAV,IDIM))
- DO JK=1,JPNSAV
- ZSAVP(JK,:) = PACK( ZSAV(JK,:),MASK=GANGL )
- END DO
-
- ALLOCATE(IMSURFP(IDIM))
- IMSURFP = PACK( IMSURF,MASK=GANGL )
-
- ALLOCATE(ZSSVP(JPNSSV,IDIM))
- DO JK=1,JPNSSV
- ZSSVP(JK,:) = PACK( ZSSV(JK,:),MASK=GANGL )
- END DO
-
- ALLOCATE(ZCVP(IDIM,IKR,JPNCVCLD))
- DO JC=1,JPNCVCLD
- DO JK=1,IKR
- ZCVP(:,JK,JC) = PACK( ZCV(:,JK,JC),MASK=GANGL )
- END DO
- END DO
-
- ALLOCATE(ZAPP(IDIM,IKR))
- DO JK=1,IKR
- ZAPP(:,JK) = PACK( ZAP(:,JK),MASK=GANGL )
- END DO
-
- ALLOCATE(ZAP_HLP(IDIM,IKR+1))
- DO JK=1,IKR+1
- ZAP_HLP(:,JK) = PACK( ZAP_HL(:,JK),MASK=GANGL )
- END DO
-
- ALLOCATE(ZREMISP(IDIM))
- ZREMISP = PACK( ZREMIS,MASK=GANGL )
-
- ALLOCATE(ZZTMP(coef%fmv_chn,KDLON))
- ALLOCATE(ZZTMPP(coef%fmv_chn,IDIM))
- ZZTMP=XUNDEF
- ZZTMPP=XUNDEF
-
- IF ( KRTTOVINFO(4,JSAT) == 1 .OR. KRTTOVINFO(4,JSAT) == 3) THEN
- ALLOCATE(ZTEMPKP(coef%fmv_chn,KDLON,JPLEV))
- ALLOCATE(ZTEMPKPP(coef%fmv_chn,IDIM,JPLEV))
- ALLOCATE(ZWVAPKP(coef%fmv_chn,KDLON,JPLEV))
- ALLOCATE(ZWVAPKPP(coef%fmv_chn,IDIM,JPLEV))
- ZTEMPKP=XUNDEF
- ZTEMPKPP=XUNDEF
- ZWVAPKP=XUNDEF
- ZWVAPKPP=XUNDEF
- ENDIF
-
- DO JIS=1,IDIM,nprofiles
- IBEG = JIS
- IEND = MIN(JIS+nprofiles-1,IDIM)
- ntruepro=IEND-IBEG+1
-
- ICPT=IBEG
- DO JI=1,ntruepro
- profiles(JI) % t(:) = ZAVP(:,1,ICPT)
- profiles(JI) % q(:) = ZAVP(:,2,ICPT)
- profiles(JI) % o3(:) = ZAVP(:,3,ICPT)
-! Surface
- profiles(JI) % s2m % p = ZSAVP(3,ICPT)
- profiles(JI) % s2m % q = ZSAVP(2,ICPT)
- profiles(JI) % s2m % t = ZSAVP(1,ICPT)
- profiles(JI) % s2m % u = ZSAVP(4,ICPT)
- profiles(JI) % s2m % v = ZSAVP(5,ICPT)
- profiles(JI) % skin % surftype = IMSURFP(ICPT)
- profiles(JI) % skin % t = ZSSVP(1,ICPT)
- profiles(JI) % skin % fastem(:) = &
-! RTTOV 8.5 example
-! (/ 3.0_JPRB, 5.0_JPRB, 15.0_JPRB, 0.1_JPRB, 0.3_JPRB /)
-! Bare soil see Table 3 svr rttov7)
- (/ 2.3_JPRB, 1.9_JPRB, 21.8_JPRB, 0.0_JPRB, 0.5_JPRB /)
-! Angles
- profiles(JI) % zenangle = ZANGLP(ICPT)
-! Cloudy atmosphere on Meso-NH levels
- cld_profiles(JI) % p (:) = ZAPP(ICPT,:)
- cld_profiles(JI) % ph (:) = ZAP_HLP(ICPT,:)
- cld_profiles(JI) % t (:) = ZCVP(ICPT,:,1)
- cld_profiles(JI) % cc (:) = ZCVP(ICPT,:,2)
- cld_profiles(JI) % clw(:) = ZCVP(ICPT,:,3)
- cld_profiles(JI) % ciw(:) = ZCVP(ICPT,:,4)
- cld_profiles(JI) % rain(:) = ZCVP(ICPT,:,5)
- cld_profiles(JI) % sp(:) = ZCVP(ICPT,:,6)
- ICPT=ICPT+1
- END DO
-
- ICAN=0
- ICPT=IBEG
- DO JI=1,ntruepro
- DO JCH=1,coef%fmv_chn
- ICAN=ICAN+1
- IF (.NOT.calcemis(ICAN)) emissivity(ICAN) = ZREMISP(ICPT)
- END DO
- ICPT=ICPT+1
- END DO
-
- IF( coef% id_sensor /= sensor_id_mw) THEN
- CALL rttov_cld( &
- & rttov_errorstatus, &! out
- & nfrequencies, &! in
- & nchannels, &! in
- & nbtout, &! in
- & nprofiles, &! in
- & channels, &! in
- & polarisations, &! in
- & lprofiles, &! in
- & profiles, &! inout (to invalid clw absorption)
- & cld_profiles, &! in
- & coef, &! in
- & calcemis, &! in
- & emissivity, &! inout
- & radiance ) ! inout
- ELSE
- iwp_levels=IKR
- CALL rttov_scatt( &
- & rttov_errorstatus, &! out
- & iwp_levels, & ! in
- & coef%nlevels, & ! in
- & nfrequencies, &! in
- & nchannels, &! in
- & nbtout, &! in
- & nprofiles, &! in
- & polarisations, &! in
- & channels, & ! in
- & frequencies, & ! in
- & lprofiles, &! in
- & lsprofiles, & ! in
- & profiles, &! inout (to invalid clw absorption)
- & cld_profiles, &! in
- & coef, &! in
- & coef_scatt, &! in
- & calcemis, &! in
- & emissivity, &! inout
- & radiance ) ! inout
- END IF
-
- IF (INRAD==1) THEN
-! cloudy radiance for given cloud
- ICAN=0
- ICPT=IBEG
- DO JI=1,ntruepro
- DO JCH=1,coef%fmv_chn
- ICAN=ICAN+1
- ZZTMPP(JCH,ICPT) = radiance%total_out (ICAN)
- END DO
- ICPT=ICPT+1
- END DO
- ELSE
-! BT equivalent to total radiance
- ICAN=0
- ICPT=IBEG
- DO JI=1,ntruepro
- DO JCH=1,coef%fmv_chn
- ICAN=ICAN+1
- ZZTMPP(JCH,ICPT) = radiance%out (ICAN)
- END DO
- ICPT=ICPT+1
- END DO
- ENDIF
-! PRINT *,'size',coef%fmv_chn,IDIM,KDLON,SIZE(ZZTMPP,1),SIZE(ZZTMPP,2)
-! PRINT *,'ZZTMP min/max ',MINVAL(ZZTMPP(:,:)),MAXVAL(ZZTMPP(:,:))
-
-
-! Calling for K code
- IF ( KRTTOVINFO(4,JSAT) == 1 .OR. KRTTOVINFO(4,JSAT) == 3) THEN
-!!! IF (JIS==1) THEN
-!! IF( coef% id_sensor /= sensor_id_mw) THEN
- CALL rttov_cld_k ( &
- & rttov_errorstatus, &! out
- & nfrequencies, &! in
- & nchannels, &! in
- & nbtout, &! in
- & nprofiles, &! in
- & channels, &! in
- & polarisations, &! in
- & lprofiles, &! in
- & profiles, &! in
- & cld_profiles, &! in
- & coef, &! in
- & switchrad, &! in
- & calcemis, &! in
- & emissivity, &! inout
- & profiles_k , &! inout
- & cld_profiles_k , &! inout
- & emissivity_k , &! inout
- & radiance) ! inout
-!!! ENDIF
-
- ICAN=0
- ICPT=IBEG
- DO JI=1,ntruepro
- DO JCH=1,coef%fmv_chn
- ICAN=ICAN+1
- DO JK=1,JPLEV
- ZTEMPKPP(JCH,ICPT,JK) = profiles_k(ICAN) % t (JK)
- ZWVAPKPP(JCH,ICPT,JK) = profiles_k(ICAN) % q (JK)
- END DO
- END DO
- ICPT=ICPT+1
- END DO
-! DO JK=1,JPLEV
-! PRINT *,JK,' temp ',MINVAL(ZTEMPKPP(:,:,JK)),MAXVAL(ZTEMPKPP(:,:,JK))
-! PRINT *,JK,' vap ',MINVAL(ZWVAPKPP(:,:,JK)),MAXVAL(ZWVAPKPP(:,:,JK))
-! END DO
- END IF
- END DO
-! Unpack the vector
- DO JCH=1,coef%fmv_chn
- ZZTMP(JCH,:) = UNPACK( ZZTMPP(JCH,:), MASK=GANGL, FIELD=XUNDEF )
- END DO
- DEALLOCATE(ZZTMPP,ZANGLP)
- DEALLOCATE(ZAVP,ZSAVP,IMSURFP,ZSSVP,ZCVP,ZAPP,ZAP_HLP,ZREMISP)
-! -----------------------------------------------------------------------------
-! Generate angle and BT images
- ALLOCATE(ZANTMP(IIU,IJU))
- ZANTMP = XUNDEF
- ALLOCATE(ZTBTMP(IIU,IJU,coef%fmv_chn))
- ZTBTMP = XUNDEF
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = (JI-JPHEXT) + (IIE-IIB+1)*(JJ-IJB)
- ZANTMP(JI,JJ) = ZANGL(IIJ)
- ZTBTMP(JI,JJ,:) = ZZTMP(:,IIJ)
- END DO
- END DO
- DEALLOCATE(ZANGL,ZZTMP)
-! -----------------------------------------------------------------------------
- IF ( KRTTOVINFO(4,JSAT) == 1 .OR. KRTTOVINFO(4,JSAT) == 3) THEN
- DO JCH=1,coef%fmv_chn
- DO JK=1,JPLEV
- ZTEMPKP(JCH,:,JK)=UNPACK(ZTEMPKPP(JCH,:,JK),MASK=GANGL,FIELD=XUNDEF )
- ZWVAPKP(JCH,:,JK)=UNPACK(ZWVAPKPP(JCH,:,JK),MASK=GANGL,FIELD=XUNDEF )
- END DO
- END DO
- DEALLOCATE(ZTEMPKPP,ZWVAPKPP)
- ENDIF
-! -----------------------------------------------------------------------------
- IF (KRTTOVINFO(3,JSAT) == 20) THEN ! MVIRI
- YINST='MVIRI'
-! YINST=inst_name(KRTTOVINFO(3,JSAT))
-! DO JK1=1,LEN_TRIM(inst_name(KRTTOVINFO(3,JSAT)))
-! YINST(JK1:JK1)=CHAR(ICHAR(YINST(JK1:JK1))-32)
-! END DO
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = TRIM(YINST)//'_ANGL', &
- CSTDNAME = '', &
- CLONGNAME = TRIM(YINST)//'_ANGL', &
- CUNITS = 'degree', &
- CDIR = 'XY', &
- CCOMMENT = TRIM(YINST)//' ANGLE' &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- PRINT *,TZFIELD%CMNHNAME//TZFIELD%CCOMMENT
- CALL IO_Field_write(TPFILE,TZFIELD,ZANTMP)
- END IF
- DEALLOCATE(ZANTMP)
-! -----------------------------------------------------------------------------
- YBEG=' '
- IF (KRTTOVINFO(1,JSAT) <= 2 .OR. KRTTOVINFO(1,JSAT) == 4) THEN ! NOAA
- WRITE(YTWO,'(I2.2)') KRTTOVINFO(2,JSAT)
- YBEG=TRIM(YPLAT(KRTTOVINFO(1,JSAT)))//YTWO
- ELSEIF (KRTTOVINFO(1,JSAT) <= JPPLAT) THEN
- WRITE(YONE,'(I1.1)') KRTTOVINFO(2,JSAT)
- YBEG=TRIM(YPLAT(KRTTOVINFO(1,JSAT)))//YONE
- ELSE
- YBEG='XXXX'
- END IF
- WRITE(YTWO,'(I2.2)') KRTTOVINFO(3,JSAT)
-!*JPC*VECTORIZATION
-! DO JCH=1,nbtout
- DO JCH=1,coef%fmv_chn
-!*JPC*VECTORIZATION
- YEND=' '
- WRITE(YCHAN,'(I2.2)') JCH
- IF (KRTTOVINFO(3,JSAT) == 0) THEN ! HIRS
- YEND='H'//YCHAN
- ELSEIF (KRTTOVINFO(3,JSAT) == 3) THEN ! AMSU-A
- YEND='A'//YCHAN
- ELSEIF (KRTTOVINFO(3,JSAT) == 4) THEN ! AMSU-B
- YEND='B'//YCHAN
- ELSEIF (KRTTOVINFO(3,JSAT) == 6) THEN ! SSMI
- YEND=YLBL_SSMI(JCH)
- ELSEIF (KRTTOVINFO(3,JSAT) == 9) THEN ! TMI
- YEND=YLBL_TMI(JCH)
- ELSEIF (KRTTOVINFO(3,JSAT) == 20) THEN ! MVIRI
- YEND=YLBL_MVIRI(JCH)
- ELSEIF (KRTTOVINFO(3,JSAT) == 21) THEN ! SEVIRI
- YEND=YLBL_SEVIRI(JCH)
- ELSEIF (KRTTOVINFO(3,JSAT) == 22) THEN ! GOES-I
- YEND=YLBL_GOESI(JCH)
- ELSE
- YEND=YTWO//YCHAN
- END IF
- IF (INRAD==1) THEN
- YMNHNAME = TRIM(YBEG)//'_'//TRIM(YEND)//'rad'
- YUNITS = 'mw/cm-1/ster/sq.m'
- YCOMMENT = TRIM(YBEG)//'_'//TRIM(YEND)//' rad'
- ELSE
- YMNHNAME = TRIM(YBEG)//'_'//TRIM(YEND)//'BT'
- YUNITS = 'K'
- YCOMMENT = TRIM(YBEG)//'_'//TRIM(YEND)//' BT'
- ENDIF
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = TRIM( YMNHNAME ), &
- CSTDNAME = '', &
- CLONGNAME = TRIM( YMNHNAME ), &
- CUNITS = TRIM( YUNITS ), &
- CDIR = 'XY', &
- CCOMMENT = TRIM( YCOMMENT ), &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- PRINT *,TZFIELD%CMNHNAME//TZFIELD%CCOMMENT, &
- MINVAL(ZTBTMP(:,:,JCH),ZTBTMP(:,:,JCH)/=XUNDEF), &
- MAXVAL(ZTBTMP(:,:,JCH),ZTBTMP(:,:,JCH)/=XUNDEF)
- CALL IO_Field_write(TPFILE,TZFIELD,ZTBTMP(:,:,JCH))
- IF (KRTTOVINFO(3,JSAT) == 4.AND. JCH==3 ) THEN ! AMSU-B
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = TRIM(YBEG)//'_UTH', &
- CSTDNAME = '', &
- CLONGNAME = TRIM(YBEG)//'_UTH', &
- CUNITS = 'percent', &
- CDIR = 'XY', &
- CCOMMENT = TRIM(YBEG)//'_UTH', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
-! UTH computation from Buehler and John JGR 2005
- ZZH= 833000. ! (m) nominal altitude of the satellite
- zdeg_to_rad = XPI / 180.0
- zrad_to_deg = 180.0 / XPI
- zbeta = zdeg_to_rad*0.55 ! angle of incident radiation
-! viewing angle alpha
- zalpha = zrad_to_deg*ASIN(XRADIUS/(XRADIUS+zzh)*SIN(zbeta))
- ALLOCATE(ZUTH(IIU,IJU))
- ZUTH = XUNDEF
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IF (ZTBTMP(JI,JJ,JCH)/=XUNDEF) THEN
- ZUTH(JI,JJ) = 100.*COS(zdeg_to_rad*zalpha) &
- *EXP(18.341-0.0764737*ZTBTMP(JI,JJ,JCH))
- END IF
- END DO
- END DO
- CALL IO_Field_write(TPFILE,TZFIELD,ZUTH)
- DEALLOCATE(ZUTH)
- END IF
- END DO
-! -----------------------------------------------------------------------------
-! Jacobian fields
- IF ( KRTTOVINFO(4,JSAT) == 1 .OR. KRTTOVINFO(4,JSAT) == 3) THEN
- ALLOCATE(ZTEMPK(IIU,IJU,IKU))
- ALLOCATE(ZWVAPK(IIU,IJU,IKU))
- ALLOCATE(ZFIN(JPLEV))
- DO JCH=1,coef%fmv_chn
- YEND=' '
- WRITE(YCHAN,'(I2.2)') JCH
- IF (KRTTOVINFO(3,JSAT) == 0) THEN ! HIRS
- YEND='H'//YCHAN
- ELSEIF (KRTTOVINFO(3,JSAT) == 3) THEN ! AMSU-A
- YEND='A'//YCHAN
- ELSEIF (KRTTOVINFO(3,JSAT) == 4) THEN ! AMSU-B
- YEND='B'//YCHAN
- ELSEIF (KRTTOVINFO(3,JSAT) == 6) THEN ! SSMI
- YEND=YLBL_SSMI(JCH)
- ELSEIF (KRTTOVINFO(3,JSAT) == 9) THEN ! TMI
- YEND=YLBL_TMI(JCH)
- ELSEIF (KRTTOVINFO(3,JSAT) == 20) THEN ! MVIRI
- YEND=YLBL_MVIRI(JCH)
- ELSEIF (KRTTOVINFO(3,JSAT) == 21) THEN ! SEVIRI
- YEND=YLBL_SEVIRI(JCH)
- ELSEIF (KRTTOVINFO(3,JSAT) == 22) THEN ! GOES-I
- YEND=YLBL_GOESI(JCH)
- ELSE
- YEND=YTWO//YCHAN
- END IF
- ZTEMPK = XUNDEF
- ZWVAPK = XUNDEF
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = (JI-JPHEXT) + (IIE-IIB+1)*(JJ-IJB)
- DO JK=1,JPLEV
- JKRAD=JPLEV-JK+1
- ZFIN(JK)=ZTEMPKP(JCH,IIJ,JKRAD)
- END DO
- CALL PINTER(ZFIN, ZPRES_INV, ZFIN, ZFIN, &
- ZTEMPK(JI,JJ,IKB:IKE), PPABST(JI,JJ,IKB:IKE), &
- 1, 1, JPLEV, 1, IKR, 'LOG', 'RHU.')
- DO JK=1,JPLEV
- JKRAD=JPLEV-JK+1
- ZFIN(JK)=ZWVAPKP(JCH,IIJ,JKRAD)
- END DO
- CALL PINTER(ZFIN, ZPRES_INV, ZFIN, ZFIN, &
- ZWVAPK(JI,JJ,IKB:IKE), PPABST(JI,JJ,IKB:IKE), &
- 1, 1, JPLEV, 1, IKR, 'LOG', 'RHU.')
- END DO
- END DO
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = TRIM(YBEG)//'_'//TRIM(YEND)//'JAT', &
- CSTDNAME = '', &
- CLONGNAME = TRIM(YBEG)//'_'//TRIM(YEND)//'JAT', &
- CUNITS = 'K K-1', &
- CDIR = 'XY', &
- CCOMMENT = TRIM(YBEG)//'_'//TRIM(YEND)//' JATEMP', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- PRINT *,TZFIELD%CMNHNAME//TZFIELD%CCOMMENT, &
- MINVAL(ZTEMPK(:,:,:),ZTEMPK(:,:,:)/=XUNDEF), &
- MAXVAL(ZTEMPK(:,:,:),ZTEMPK(:,:,:)/=XUNDEF)
- CALL IO_Field_write(TPFILE,TZFIELD,ZTEMPK(:,:,:))
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = TRIM(YBEG)//'_'//TRIM(YEND)//'JAV', &
- CSTDNAME = '', &
- CLONGNAME = TRIM(YBEG)//'_'//TRIM(YEND)//'JAV', &
- CUNITS = 'K', &
- CDIR = 'XY', &
- CCOMMENT = TRIM(YBEG)//'_'//TRIM(YEND)//' JAWVAP', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- WHERE (ZWVAPK(:,:,:) /= XUNDEF) &
- ZWVAPK(:,:,:)=ZWVAPK(:,:,:)*(-0.1*PRT(:,:,:,1))
- PRINT *,TZFIELD%CMNHNAME//TZFIELD%CCOMMENT, &
- MINVAL(ZWVAPK(:,:,:),ZWVAPK(:,:,:)/=XUNDEF), &
- MAXVAL(ZWVAPK(:,:,:),ZWVAPK(:,:,:)/=XUNDEF)
- CALL IO_Field_write(TPFILE,TZFIELD,ZWVAPK(:,:,:))
- END DO
- DEALLOCATE(ZTEMPKP,ZWVAPKP,ZFIN)
- ENDIF
-! -----------------------------------------------------------------------------
- DEALLOCATE(GANGL,ZTBTMP)
- DEALLOCATE(channels,lprofiles,lsprofiles,lsprofiles2,emissivity,frequencies)
- DEALLOCATE(n_chan,polarisations,input_emissivity,calcemis)
- DEALLOCATE( transmission % tau_surf )
- DEALLOCATE( transmission % tau_layer )
- DEALLOCATE( transmission % od_singlelayer )
- DEALLOCATE(radiance % clear)
- DEALLOCATE( radiance % cloudy)
- DEALLOCATE( radiance % total )
- DEALLOCATE( radiance % bt )
- DEALLOCATE( radiance % bt_clear )
- DEALLOCATE( radiance % upclear )
- DEALLOCATE( radiance % dnclear )
- DEALLOCATE( radiance % reflclear )
- DEALLOCATE( radiance % overcast )
- DEALLOCATE( radiance % downcld )
- DEALLOCATE( radiance % cldemis )
- DEALLOCATE( radiance % wtoa )
- DEALLOCATE( radiance % wsurf )
- DEALLOCATE( radiance % cs_wtoa )
- DEALLOCATE( radiance % cs_wsurf )
- DEALLOCATE( radiance % out )
- DEALLOCATE( radiance % out_clear )
- DEALLOCATE( radiance % total_out )
- DEALLOCATE( radiance % clear_out )
- IF ( KRTTOVINFO(4,JSAT) == 1 .OR. KRTTOVINFO(4,JSAT) == 3) THEN
- DEALLOCATE(ZTEMPK,ZWVAPK)
- DEALLOCATE( profiles_k)
- DEALLOCATE( cld_profiles_k)
- DEALLOCATE( emissivity_k)
- ENDIF
-END DO
-DEALLOCATE(ZULAT,ZULON,ZANGS,IMSURF)
-DEALLOCATE(ZAV,ZSAV,ZSSV,ZCV,ZAP,ZAP_HL)
-#else
-PRINT *, "RTTOV 8.7 LIBRARY NOT AVAILABLE = ###CALL_RTTOV8####"
-#endif
-!
-END SUBROUTINE CALL_RTTOV8
diff --git a/src/MNH/diag.f90 b/src/MNH/diag.f90
index acbfb2365..03f31d9ee 100644
--- a/src/MNH/diag.f90
+++ b/src/MNH/diag.f90
@@ -199,7 +199,7 @@ REAL, DIMENSION(:,:,:,:),ALLOCATABLE :: ZWETDEPAER
TYPE(TFILEDATA),POINTER :: TZNMLFILE => NULL() !Namelist file
!
NAMELIST/NAM_DIAG/ CISO, LVAR_RS, LVAR_LS, &
- NCONV_KF, NRAD_3D, CRAD_SAT, NRTTOVINFO, LRAD_SUBG_COND, &
+ NCONV_KF, NRAD_3D, NRTTOVINFO, LRAD_SUBG_COND, &
LVAR_TURB,LTURBFLX,LTURBDIAG,LMFFLX,XDTSTEP, &
LVAR_MRW, LVAR_MRSV, LVAR_FRC, &
LTPZH, LMOIST_V, LMOIST_E,LMOIST_ES, &
@@ -248,7 +248,6 @@ LVAR_RS=.TRUE.
LVAR_LS=.FALSE.
NCONV_KF=-1
NRAD_3D=-1
-CRAD_SAT=' '
LRAD_SUBG_COND=.TRUE.
NRTTOVINFO(:,:)=NUNDEF
LVAR_TURB=.FALSE.
@@ -567,10 +566,6 @@ IF (NRAD_3D >= 0) THEN
END IF
END IF
!
-IF (LEN_TRIM(CRAD_SAT) /= 0 .AND. YRAD/='ECMW') THEN
- CRAD = 'ECMW'
-END IF
-!
!
IF ( CTURB /= 'NONE' .OR. CDCONV /= 'NONE' .OR. CSCONV /= 'NONE' &
.OR. CRAD /= 'NONE' ) THEN
diff --git a/src/MNH/modd_diag_flag.f90 b/src/MNH/modd_diag_flag.f90
index 3115f1426..94ce52ed5 100644
--- a/src/MNH/modd_diag_flag.f90
+++ b/src/MNH/modd_diag_flag.f90
@@ -56,7 +56,6 @@ LOGICAL :: LVAR_RS ! UM,VM,WM,RVM
LOGICAL :: LVAR_LS ! LSUM,LSVM,LSWM,LSRVM
INTEGER :: NCONV_KF ! Convective scheme
INTEGER :: NRAD_3D ! Radiative scheme
-CHARACTER(LEN=44) :: CRAD_SAT ! GOES-E,GOES-W,GMS,INDSAT,METEOSAT
LOGICAL :: LRAD_SUBG_COND ! to activate subgrid condensation
!scheme in the radiatif transfer code
!rttov and satellites variables
diff --git a/src/MNH/nband_model.fx90 b/src/MNH/nband_model.fx90
deleted file mode 100644
index 6005b8387..000000000
--- a/src/MNH/nband_model.fx90
+++ /dev/null
@@ -1,2286 +0,0 @@
-!MNH_LIC Copyright 1996-2021 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-***FILE: nband_model.f
-***AUTHOR: J.-P. Chaboureau *LA*
-***DATE: 29/03/00
-***ORIGINAL: original from JEAN-JACQUES MORCRETTE *ECMWF* 96/12/20
-***MODIFIED: I.Mallet (02/11/00) added F90 Interface (MODD_RAD_TRANSF)
-* and changed name of variables concerned
-* indicated by "*MNH"
-* named nband_model.f90 and compiled with -Fixed
-* J.Escobar (1/12/2017) bug => intialized all ZV=0.0 in spectr
-* P. Wautelet 21/11/2019: replace several CONTINUE (workaround of problems with gfortran OpenACC)
-* P. Wautelet 17/12/2021: comment ZBSUI variable (not used and was not initialized)
-*
- SUBROUTINE NBMVEC
- I ( KIDIA ,KFDIA ,KLON,KLEV,KGL,KCABS,KNG1,KUABS
- I , KH2O ,KCO2 ,KO3,KCNT,KN2O,KCH4,KCO,KC11,KC12,KCFC
- I , KINIS ,KENDS ,KCONF,KCLOUD,KOVLP
- L , LPVOIGT, LPTDEP
- R , PTAVE, PQVAVE, PO3AVE, PPL, PT
- R , PANGLE , PCLDLD, PCLDLU
- R , PDT0 ,PEM0
-c R , PFBBDC ,PFBBDT,PFBBUC,PFBBUT
-c R , PFDC ,PFDT ,PFDTI,PFUC,PFUT,PFUTI
- R , PRADC ,PRADT)
-C
-C**** *NBMVEC* - VECTORIZED NARROW BAND MODEL OF THE LONGWAVE RADIATION
-C TRANSFER
-C
-C** INTERFACE
-C ---------
-C *NBMVEC* IS CALLED BY *NARROW*
-C
-C ARGUMENTS
-C ---------
-C === INPUTS ===
-C KIDIA : START OF VECTOR
-C KFDIA : END OF VECTOR
-C KLON : TOTAL LENGTH OF VECTOR
-C KLEV : NUMBER OF FULL-LEVELS (LAYERS)
-C KGL : NUMBER OF SUB-LAYERS IN VERTICAL INTEGRATION
-C KCABS : CONFIGURATION INDEX FOR ABSORBERS
-C LPVOIGT : .T. IF VOIGT PROFILE IS ACCOUNTED FOR
-C === OUTPUTS ===
-C PFBBDC : BROAD-BAND DOWNWARD CLEAR-SKY FLUXES (SURF./TOA)
-C PFBBDT : BROAD-BAND DOWNWARD TOTAL FLUXES (SURF./TOA)
-C PFBBUC : BROAD-BAND UPWARD CLEAR-SKY FLUXES (SURF./TOA)
-C PFBBUT : BROAD-BAND UPWARD TOTAL FLUXES (SURF./TOA)
-C PFDC,PFUC: CLEAR-SKY FLUXES (ALL HALF-LEVELS)
-C PFDT,PFUT: TOTAL FLUXES (ALL HALF-LEVELS)
-C PRADC : CLEAR-SKY SPECTRAL RADIANCE AT T.O.A.
-C PRADT : TOTAL-SKY SPECTRAL RADIANCE AT T.O.A.
-C
-C METHOD
-C ------
-C
-C REFERENCE
-C ---------
-C
-C AUTHOR
-C ------
-C JEAN-JACQUES MORCRETTE *ECMWF* 96/12/20
-C
-C MODIFICATIONS
-C -------------
-C
-C ------------------------------------------------------------------
-*MNH
- USE MODD_RAD_TRANSF
-*MNH
- !include 'implic.h'
- LOGICAL LPTDEP, LPVOIGT
- !include 'param.h'
-*MNH INTEGER JNINT,JUABS,JUAMO,JV2,JV3,JV10
-*MNH PARAMETER (JNINT=225,JUABS=14,JUAMO=8,JV2=2,JV3=3,JV10=10)
- !include 'yomgos.h'
-*MNH real RT1(2),WG1(2)
-*MNH COMMON /YOMGOS/ RT1,WG1
- !include 'yomio.h'
-*MNH integer IMP,NIMP,NULOUT,NULINA,NULNAM
-*MNH COMMON /YOMIO/ IMP,NIMP,NULOUT,NULINA,NULNAM
- !include 'yomrad.h'
-*MNH integer NABS,NATM,NATMS,NSPWV,NTMP1,NTEMP,NCH2O,NCCO2,NCO3,
-*MNH & NCHAN,NH2O,NCO2,NO3,NCNT,NN2O,NCH4,NCO,NC11,NC12,NCFC,NO2
-*MNH real CVCO2,CVN2O,CVCO,CVCH4,CVF11,CVF12,CVO2,FTEMP(JV3),
-*MNH & FCH2O(JV3),FCCO2(JV3),FCO3(JV3),XLIM(JV10),CLIM(JV2)
-*MNH COMMON/YOMRADI/NABS,NATM,NATMS,NSPWV,NTMP1,NTEMP,NCH2O,NCCO2,NCO3,
-*MNH & NCHAN,NH2O,NCO2,NO3,NCNT,NN2O,NCH4,NCO,NC11,NC12,NCFC,NO2
-*MNH COMMON /YOMRADR/CVCO2,CVN2O,CVCO,CVCH4,CVF11,CVF12,CVO2,
-*MNH & FTEMP,FCH2O,FCCO2,FCO3,XLIM,CLIM
- !include 'yomspe.h'
-*MNH integer N_INT,NA
-*MNH real TREF,TPOLY
-*MNH real WNU(JV2),RODWAL(6,8),POLPLCK(6,2),WVNA(JNINT),WVNB(JNINT),
-*MNH & RALPHA,RPI,RAIRM,RH2OM,RCO2M,RO3M,RN2OM,RCOM,RCH4M,RO2M,
-*MNH & RF11M,RF12M
-*MNH COMMON /YOMSPEI/ N_INT,NA,TREF,TPOLY
-*MNH COMMON /YOMSPER/ WNU,RODWAL,POLPLCK,WVNA,WVNB,RALPHA,RPI,
-*MNH & RAIRM,RH2OM,RCO2M,RO3M,RN2OM,RCOM,RCH4M,RO2M,RF11M,RF12M
-*MNH real WNUTOT(2,20), POLPLCKTOT(6,2,20), RODWALTOT(6,8,20)
-*MNH COMMON /YOMSPET/ WNUTOT, RODWALTOT, POLPLCKTOT
-C ------------------------------------------------------------------
-C
-C 0.1 ARGUMENTS
-C
-C
- REAL PDT0(KLON), PEM0(KLON), PPL(KLON,KLEV+1), PT(KLON,KLEV+1)
- REAL PO3AVE(KLON,KLEV), PQVAVE(KLON,KLEV), PTAVE(KLON,KLEV)
- REAL PCLDLD(KLON,KLEV), PCLDLU(KLON,KLEV)
- REAL PANGLE(KLON)
- REAL PRADC(KLON,20), PRADT(KLON,20)
-C ------------------------------------------------------------------
-C
- REAL
- * ZDPM(KLON,3*KLEV) , ZDUC(KLON,3*KLEV)
- * , ZSSIG(KLON,3*KLEV+1)
- * , ZU(KLON,8,3*KLEV+1) , ZUPM(KLON,3*KLEV)
- * , ZXT(KLON,3,3*KLEV+1) , ZXOZ(KLON) , ZXWV(KLON)
-C ------------------------------------------------------------------
-C
-C ------------------------------------------------------------------
-C
-C 1. INITIALISATION
-C --------------
- 100 CONTINUE
-C
-C IF (NIMP.EQ.0) STOP
-
- PVGH2O = 30.
- PVGCO2 = 60.
- PVGO3 = 400.
- RG = 9.80665
- ZEPSCO = 1.E-12
- !ZEPSCQ = 1.E-12 NOT ENOUGH
- ZEPSCQ = 1.E-8
-*MNH PCMCO2 = CVCO2 * RCO2M / RAIRM
- PCMCO2 = X1CO2 * XCO2M / XAIRM
-*MNH PCMN2O = CVN2O * RN2OM / RAIRM
- PCMN2O = XN2O * XN2OM / XAIRM
-*MNH PCMCH4 = CVCH4 * RCH4M / RAIRM
- PCMCH4 = XCH4 * XCH4M / XAIRM
-C
- DO JA=1,8
- DO JK=1,KGL+1
- DO JL=KIDIA,KFDIA
- ZU(JL,JA,JK)=0.
- END DO
- END DO
- END DO
- DO JA=1,3
- DO JK=1,KGL+1
- DO JL=KIDIA,KFDIA
- ZXT(JL,JA,JK)=0.
- END DO
- END DO
- END DO
-c DO 113 JNIV=1,2
-c DO 112 JSI=1,10
-c DO 111 JL=KIDIA,KFDIA
-c PFBBDC(JL,JSI,JNIV)=0.
-c PFBBUC(JL,JSI,JNIV)=0.
-c PFBBDT(JL,JSI,JNIV)=0.
-c PFBBUT(JL,JSI,JNIV)=0.
-c 111 CONTINUE
-c 112 CONTINUE
-c 113 CONTINUE
-C
-C ------------------------------------------------------------------
-C
-C* 2. PRESSURE OVER GAUSS SUB-LEVELS
-C ------------------------------
-C
- 200 CONTINUE
-C
- IG1P1=KNG1+1
- DO JL=KIDIA,KFDIA
- ZSSIG(JL,1)=PPL(JL,1)
- END DO
-C
- DO JK = 1 , KLEV
- JKJ=(JK-1)*IG1P1+1
- JKJR = JKJ
- JKJP = JKJ + IG1P1
- DO JL = KIDIA,KFDIA
- ZSSIG(JL,JKJP)=PPL(JL,JK+1)
- END DO
- DO IG1=1,KNG1
- JKJ=JKJ+1
- DO JL = KIDIA,KFDIA
- ZSSIG(JL,JKJ)= (ZSSIG(JL,JKJR)+ZSSIG(JL,JKJP))*0.5
-*MNH S + RT1(IG1) * (ZSSIG(JL,JKJP) - ZSSIG(JL,JKJR)) * 0.5
- S + XRT1(IG1) * (ZSSIG(JL,JKJP) - ZSSIG(JL,JKJR)) * 0.5
- END DO
- END DO
- END DO
-C
-C-----------------------------------------------------------------------
-C
-C* 3. PRESSURE THICKNESS AND MEAN PRESSURE OF SUB-LAYERS
-C --------------------------------------------------
-C
- 300 CONTINUE
-C
- DO 302 JKI=1,KGL
- JKIP1=JKI+1
- DO 301 JL = KIDIA,KFDIA
- ZUPM(JL,JKI)=(ZSSIG(JL,JKI)+ZSSIG(JL,JKIP1))*0.5
- ZDPM(JL,JKI)=(ZSSIG(JL,JKI)-ZSSIG(JL,JKIP1))/(10.*RG)
- 301 CONTINUE
-C IF (NIMP.EQ.0) THEN
-C JL=KIDIA
-C PRINT 9301,JKI,ZDPM(JL,JKI),ZUPM(JL,JKI)
-C 9301 FORMAT(1X,I4,2E13.6)
-C END IF
- 302 CONTINUE
-C
- DO JK = 1 , KLEV
- JKP1=JK+1
- JKL = KLEV+1 - JK
- DO JL = KIDIA,KFDIA
- ZXWV(JL) = MAX (PQVAVE(JL,JK) , ZEPSCQ )
- ZXOZ(JL) = MAX (PO3AVE(JL,JK) , ZEPSCO )
- END DO
- JKJ=(JK-1)*IG1P1+1
- JKJPN=JKJ+KNG1
- DO JKK=JKJ,JKJPN
- DO JL = KIDIA,KFDIA
- ZUPMH2O = ( ZUPM(JL,JKK) + PVGH2O ) * ZDPM(JL,JKK) / 101325.
- ZUPMCO2 = ( ZUPM(JL,JKK) + PVGCO2 ) * ZDPM(JL,JKK) / 101325.
- ZUPMO3 = ( ZUPM(JL,JKK) + PVGO3 ) * ZDPM(JL,JKK) / 101325.
- ZDUC(JL,JKK)= ZDPM(JL,JK)
- ZU6= ZXWV(JL) * ZUPMH2O
- ZFPPW= 1.6078 * ZXWV(JL) / (1.+0.608*ZXWV(JL))
- ZU(JL, 1,JKK) = ZXWV(JL) * ZDPM(JL,JKK)
- ZU(JL, 2,JKK) = ZXWV(JL) * ZUPMH2O
- ZU(JL, 3,JKK) = PCMCO2 * ZDPM(JL,JKK)
- ZU(JL, 4,JKK) = PCMCO2 * ZUPMCO2
- ZU(JL, 5,JKK) = ZXOZ(JL) * ZDPM(JL,JKK)
- ZU(JL, 6,JKK) = ZXOZ(JL) * ZUPMO3
- ZU(JL, 7,JKK) = ZU6 * ZFPPW
- ZU(JL, 8,JKK) = ZU6 * (1.-ZFPPW)
- END DO
- END DO
- END DO
- DO JA=1,8
- DO JL=KIDIA,KFDIA
- ZU(JL,JA,KGL+1) = 0.
- END DO
- END DO
-C IF (NIMP.EQ.0) THEN
-C DO 312 JK=1,KGL+1
-C PRINT 9312,JK,(ZU(KIDIA,JA,JK),JA=1,8)
-C 9312 FORMAT(1X,I4,8E13.6)
-C 312 CONTINUE
-C END IF
-C
- CALL SPECTR
- I ( KIDIA,KFDIA,KLON,KLEV,KGL,KCABS,KNG1,KUABS
- I , KH2O,KCO2,KO3,KCNT,KN2O,KCH4,KCO,KC11,KC12,KCFC
- I , KINIS,KENDS,KCONF,KCLOUD,KOVLP
- L , LPVOIGT,LPTDEP
- R , PCMCO2, PCMN2O, PCMN2O, PCMCH4, PCMO2, PCMF11, PCMF12
- R , PANGLE,PCLDLD, PCLDLU
- R , PDT0,PEM0
- R , PT,PTAVE
- R , ZU
- R , PRADC,PRADT
- S )
-
-C
-C ------------------------------------------------------------------
-C
- RETURN
- END
- SUBROUTINE SPECTR
- I ( KIDIA,KFDIA,KLON,KLEV,KGL,KCABS,KNG1,KUABS
- I , KH2O,KCO2,KO3,KCNT,KN2O,KCH4,KCO,KC11,KC12,KCFC
- I , KINIS,KENDS,KCONF,KCLOUD,KOVLP
- L , LPVOIGT,LPTDEP
- R , PCMCO2, PCMN2O, PCMCO, PCMCH4, PCMO2, PCMF11, PCMF12
- R , PANGLE,ZCLDLD, ZCLDLU
- R , PDT0,PEM0, PT,PTAVE, PU , PRADC,PRADT)
-C
-C**** *SPECTR* - PERFORMS THE SPECTRAL INTEGRATION
-C
-C** INTERFACE
-C ---------
-C *SPECTR* IS CALLED BY *NBMVEC*
-C
-C ARGUMENTS
-C ---------
-C === INPUTS ===
-C KIDIA : START OF VECTOR
-C KFDIA : END OF VECTOR
-C KLON : TOTAL LENGTH OF VECTOR
-C KLEV : NUMBER OF FULL-LEVELS (LAYERS)
-C KGL : NUMBER OF SUB-LAYERS IN VERTICAL INTEGRATION
-C KCABS : CONFIGURATION INDEX FOR ABSORBERS
-C LPVOIGT : .T. IF VOIGT PROFILE IS ACCOUNTED FOR
-C === OUTPUTS ===
-C PRADC : CLEAR-SKY SPECTRAL RADIANCE (UPWARD AT TOA)
-C PRADT : TOTAL-SKY SPECTRAL RADIANCE (UPWARD AT TOA)
-C
-C METHOD
-C ------
-C
-C REFERENCE
-C ---------
-C
-C AUTHOR
-C ------
-C JEAN-JACQUES MORCRETTE *ECMWF* 96/12/20
-C
-C MODIFICATIONS
-C -------------
-C Remy Roca LMD 97 03 03
-c This version is only dedicated to the calculation of the radiance
-c as the satellite may have seen - Jean-Pierre Chaboureau (Dec. 1998).
-c Thus all the flux outputs have been removed to save memory space.
-C ------------------------------------------------------------------
-*MNH
- USE MODD_RAD_TRANSF
-*MNH
- LOGICAL LPTDEP, LPVOIGT, LLCNT
- !include 'param.h'
-*MNH INTEGER JNINT,JUABS,JUAMO,JV2,JV3,JV10
-*MNH PARAMETER (JNINT=225,JUABS=14,JUAMO=8,JV2=2,JV3=3,JV10=10)
- !include 'yomgos.h'
-*MNH real RT1(2),WG1(2)
-*MNH COMMON /YOMGOS/ RT1,WG1
- !include 'yomio.h'
-*MNH integer IMP,NIMP,NULOUT,NULINA,NULNAM
-*MNH COMMON /YOMIO/ IMP,NIMP,NULOUT,NULINA,NULNAM
- !include 'yomrad.h'
-*MNH integer NABS,NATM,NATMS,NSPWV,NTMP1,NTEMP,NCH2O,NCCO2,NCO3,
-*MNH & NCHAN,NH2O,NCO2,NO3,NCNT,NN2O,NCH4,NCO,NC11,NC12,NCFC,NO2
-*MNH real CVCO2,CVN2O,CVCO,CVCH4,CVF11,CVF12,CVO2,FTEMP(JV3),
-*MNH & FCH2O(JV3),FCCO2(JV3),FCO3(JV3),XLIM(JV10),CLIM(JV2)
-*MNH COMMON/YOMRADI/NABS,NATM,NATMS,NSPWV,NTMP1,NTEMP,NCH2O,NCCO2,NCO3,
-*MNH & NCHAN,NH2O,NCO2,NO3,NCNT,NN2O,NCH4,NCO,NC11,NC12,NCFC,NO2
-*MNH COMMON /YOMRADR/CVCO2,CVN2O,CVCO,CVCH4,CVF11,CVF12,CVO2,
-*MNH & FTEMP,FCH2O,FCCO2,FCO3,XLIM,CLIM
- !include 'yomspe.h'
-*MNH integer N_INT,NA
-*MNH real TREF,TPOLY
-*MNH real WNU(JV2),RODWAL(6,8),POLPLCK(6,2),WVNA(JNINT),WVNB(JNINT),
-*MNH & RALPHA,RPI,RAIRM,RH2OM,RCO2M,RO3M,RN2OM,RCOM,RCH4M,RO2M,
-*MNH & RF11M,RF12M
-*MNH COMMON /YOMSPEI/ N_INT,NA,TREF,TPOLY
-*MNH COMMON /YOMSPER/ WNU,RODWAL,POLPLCK,WVNA,WVNB,RALPHA,RPI,
-*MNH & RAIRM,RH2OM,RCO2M,RO3M,RN2OM,RCOM,RCH4M,RO2M,RF11M,RF12M
-*MNH real WNUTOT(2,20), POLPLCKTOT(6,2,20), RODWALTOT(6,8,20)
-*MNH COMMON /YOMSPET/ WNUTOT, RODWALTOT, POLPLCKTOT
-C ------------------------------------------------------------------
-C
-C 0.1 ARGUMENTS
-C
-C
- REAL PT(KLON,KLEV+1),PDT0(KLON),PEM0(KLON)
- REAL PTAVE(KLON,KLEV)
- REAL PANGLE(KLON), PU(KLON,8,KGL+1)
- REAL ZCLDLD(KLON,KLEV),ZCLDLU(KLON,KLEV)
-C
- REAL PCNTRB(KLON,KLEV+1,KLEV+1),PRADC(KLON,20),PRADT(KLON,20)
-C ------------------------------------------------------------------
-C
-C 0.2 LOCAL ARRAYS
-C
- REAL
- * ZBINT(KLON,KLEV+1)
- * , ZBLAY(KLON,KLEV)
- * , ZBLEV(KLON,KLEV+1)
- * , ZCNTRB(KLON,KLEV+1,KLEV+1)
- * , ZDZ(KLON,KLEV)
- * , ZTAVSL(KLON,3*KLEV)
-*MNH * , ZV(KLON,JUABS,3*KLEV+1)
- * , ZV(KLON,JPUABS,3*KLEV+1)
- * , ZDBSL(KLON,2*KLEV)
- * , ZCDBSL(KLON,2*KLEV)
- REAL
- * ZBSUI(KLON), ZRES(KLON) ,ZRES2(KLON), ZTI(KLON)
- * , ZTI2(KLON)
- * , ZBSUR(KLON)
- REAL
- * ZFDC(KLON,KLEV+1),ZFDT(KLON,KLEV+1)
- * , ZFUC(KLON,KLEV+1),ZFUT(KLON,KLEV+1)
-C
-C ------------------------------------------------------------------
-C
-C* 1. INITIALIZATION
-C
- 100 CONTINUE
-C
-C IF (NIMP.EQ.0) STOP
-
- IF (KCONF.EQ.0) THEN
- IBOT=1
- ITOP=KLEV+1
- IVDIS=KLEV
- ELSE IF (KCONF.EQ.1) THEN
- IBOT=1
- ITOP=KLEV+1
- IVDIS=1
- ELSE
- IBOT=1
- ITOP=KLEV+1
- IVDIS=1
- WRITE (NULOUT,9101) KCONF
- END IF
-C
-
-
- INH2O=1
- INCO2=2
- INO3 =3
- INN2O=4
- INCH4=5
- INCO =6
- INC11=7
- INC12=8
- INCFC=9
-C
- DO 103 JK1=1,KLEV+1
- DO 102 JK2=1,KLEV+1
- DO 101 JL=KIDIA,KFDIA
- PCNTRB(JL,JK1,JK2)=0.
- 101 CONTINUE
- 102 CONTINUE
- 103 CONTINUE
-C
- IG1P1=KNG1+1
- DO 113 JK=1,KLEV
- JJ=(JK-1)*IG1P1+1
- JJPN=JJ+KNG1
- DO 112 JKSL=JJ,JJPN
- DO 111 JL=KIDIA,KFDIA
- ZTAVSL(JL,JKSL)=PTAVE(JL,JK)
- 111 CONTINUE
- 112 CONTINUE
- 113 CONTINUE
- DO JK=1,2*KLEV
- DO JL=KIDIA,KFDIA
- ZCDBSL(JL,JK)=0.
- END DO
- END DO
-C
-C ------------------------------------------------------------------
-C
-C 2. LOOP ON WAVENUMBER
-C
- 200 CONTINUE
-C
- DO 499 JWVN=KINIS,KENDS
-C
- IH2O=1
- ICNT=1
- ICO2=1
- IO3 =1
- IN2O=1
- ICH4=1
- ICO =1
- IC11=1
- IC12=1
- ICFC=1
-C
-C
-C* 2.1 READ COEFFICIENTS FOR A GIVEN SPECTRAL INTERVAL
-C
- 210 CONTINUE
- do JNU=1,2
-*MNH WNU(JNU)= WNUTOT(JNU,JWVN)
- XWNU(JNU)= XWNUTOT(JNU,JWVN)
-*MNH
- end do
- do JPLA=1,2
- do JPOL=1,6
-*MNH POLPLCK(JPOL,JPLA)= POLPLCKTOT(JPOL,JPLA,JWVN)
- XPOLPLCK(JPOL,JPLA)= XPOLPLCKTOT(JPOL,JPLA,JWVN)
-*MNH
- end do
- end do
- do JABS=1,NA
- do JCOE=1,6
-*MNH RODWAL(JCOE,JABS)= RODWALTOT(JCOE,JABS,JWVN)
- XRODWAL(JCOE,JABS)= XRODWALTOT(JCOE,JABS,JWVN)
-*MNH
- end do
- end do
-C
-C
-C* 2.2 INITIALIZATION
-C
- 220 CONTINUE
-C
- IBBF=1
- DO ICHAN=1,NCHAN
-*MNH IF (WNU(1).GE.XLIM(ICHAN)) IBBF=ICHAN
- IF (XWNU(1).GE.XXLIM(ICHAN)) IBBF=ICHAN
-*MNH
- END DO
-c IF (WNU(1).GE.XLIM(1)) IBBF=1
-c IF (WNU(1).GE.XLIM(2)) IBBF=2
-c IF (WNU(1).GE.XLIM(3)) IBBF=3
-c IF (WNU(1).GE.XLIM(4)) IBBF=4
-c IF (WNU(1).GE.XLIM(5)) IBBF=5
-c IF (WNU(1).GE.XLIM(6)) IBBF=6
-c IF (WNU(1).GE.XLIM(7)) IBBF=7
-c IF (WNU(1).GE.XLIM(8)) IBBF=8
-c IF (WNU(1).GE.XLIM(9)) IBBF=9
-C
-*MNH ZWVN=0.5*(WNU(1)+WNU(2))
- ZWVN=0.5*(XWNU(1)+XWNU(2))
-*MNH WVNA(JWVN)=WNU(1)
- XWVNA(JWVN)=XWNU(1)
-*MNH WVNB(JWVN)=WNU(2)
- XWVNB(JWVN)=XWNU(2)
-*MNH
-C
- DO 224 JKSL=1,2*KLEV
- DO 221 JL=KIDIA,KFDIA
- ZDBSL(JL,JKSL)=0.
- 221 CONTINUE
- DO 223 JABS=1,KUABS
- DO 222 JL=KIDIA,KFDIA
-C ZV(JL,JABS,JKSL)=0.
- 222 CONTINUE
- 223 CONTINUE
- 224 CONTINUE
-C
- ZV = 0.0
-C
- LLCNT=.FALSE.
-*MNH IF (WNU(1).LT.CLIM(1) .OR. WNU(1).GE.CLIM(2)) ICNT=0
- IF (XWNU(1).LT.XCLIM(1) .OR. XWNU(1).GE.XCLIM(2)) ICNT=0
-*MNH IF (WNU(1).GE.330. .OR. WNU(1).LE.1300. ) LLCNT=.TRUE.
- IF (XWNU(1).GE.330. .OR. XWNU(1).LE.1300. ) LLCNT=.TRUE.
-*MNH
-CCO2 IF (WNU(1).LT.500. .OR. WNU(1).GE.1250. ) ICO2=0
-CO3 IF (WNU(1).LT.970. .OR. WNU(1).GE.1110. ) IO3 =0
-C
-*MNH ZA1=RODWAL(1,INH2O)
- ZA1=XRODWAL(1,INH2O)
-*MNH ZA2=RODWAL(1,INCO2)
- ZA2=XRODWAL(1,INCO2)
-*MNH ZA3=RODWAL(1,INO3 )
- ZA3=XRODWAL(1,INO3 )
-*MNH ZA4=RODWAL(1,INN2O)
- ZA4=XRODWAL(1,INN2O)
-*MNH ZA5=RODWAL(1,INCH4)
- ZA5=XRODWAL(1,INCH4)
-*MNH
-C
-C IF (NIMP.EQ.0) THEN
-C PRINT 9224,ZA1,ZA2,ZA3,ZA4,ZA5,KH2O,KCO2,KO3 ,KN2O,KCH4
-C 9224 FORMAT(1X,5E13.6,5I3)
-C END IF
- IF (ZA1.EQ.0. .OR. KH2O.EQ.0) IH2O=0
- IF (ZA2.EQ.0. .OR. KCO2.EQ.0) ICO2=0
- IF (ZA3.EQ.0. .OR. KO3 .EQ.0) IO3 =0
- IF (ZA4.EQ.0. .OR. KN2O.EQ.0) IN2O=0
- IF (ZA5.EQ.0. .OR. KCH4.EQ.0) ICH4=0
- IF (NCNT.EQ.0) ICNT=0
- ICO = 0
- IC11= 0
- IC12= 0
- ICFC= 0
-C
-c PRINT 9221,JWVN,WNU(1),WNU(2),IH2O,ICO2,IO3,IN2O,ICH4,ICNT
-c $ ,ICO,IC11,IC12,ICFC
-C IF (NIMP.EQ.0) THEN
-C PRINT 9221,JWVN,WNU(1),WNU(2),IH2O,ICO2,IO3,IN2O,ICH4,ICNT
-C $ ,ICO,IC11,IC12,ICFC
-C 9221 FORMAT(1X,'JWVN= ',I3,' WV= ',F8.2,' - ',F8.2,2X,10I3)
-C END IF
-C
-C
-C
-C
-C* 2.3 INTRODUCTION OF THE TEMPERATURE EFFECT
-C
- 230 CONTINUE
-C
- IF (IH2O.NE.0) THEN
- DO 232 JKSL=KGL,1,-1
- DO 231 JL=KIDIA,KFDIA
- IF (LPTDEP) THEN
-*MNH ZTX =ZTAVSL(JL,JKSL)-TREF
- ZTX =ZTAVSL(JL,JKSL)-XTREF
- ZTX2=ZTX*ZTX
-*MNH ZPHI=RODWAL(3,INH2O)*ZTX+RODWAL(4,INH2O)*ZTX2
- ZPHI=XRODWAL(3,INH2O)*ZTX+XRODWAL(4,INH2O)*ZTX2
-*MNH ZPSI=RODWAL(5,INH2O)*ZTX+RODWAL(6,INH2O)*ZTX2
- ZPSI=XRODWAL(5,INH2O)*ZTX+XRODWAL(6,INH2O)*ZTX2
-*MNH
- ZUA =PU(JL,1,JKSL)*EXP (ZPHI)
- ZUB =PU(JL,2,JKSL)*EXP (2.*ZPSI)
- ELSE
- ZUA =PU(JL,1,JKSL)
- ZUB =PU(JL,2,JKSL)
- END IF
- ZV(JL,1,JKSL)=ZV(JL,1,JKSL+1)+ZUA
- ZV(JL,2,JKSL)=ZV(JL,2,JKSL+1)+ZUB
- 231 CONTINUE
- 232 CONTINUE
- END IF
-C IF (NIMP.EQ.0) print *,' SPECTR after 232 '
-C
- IF (ICO2.NE.0) THEN
- DO 234 JKSL=KGL,1,-1
- DO 233 JL=KIDIA,KFDIA
- IF (LPTDEP) THEN
-*MNH ZTX =ZTAVSL(JL,JKSL)-TREF
- ZTX =ZTAVSL(JL,JKSL)-XTREF
- ZTX2=ZTX*ZTX
-*MNH ZPHI=RODWAL(3,INCO2)*ZTX+RODWAL(4,INCO2)*ZTX2
- ZPHI=XRODWAL(3,INCO2)*ZTX+XRODWAL(4,INCO2)*ZTX2
-*MNH ZPSI=RODWAL(5,INCO2)*ZTX+RODWAL(6,INCO2)*ZTX2
- ZPSI=XRODWAL(5,INCO2)*ZTX+XRODWAL(6,INCO2)*ZTX2
-*MNH
- ZUA =PU(JL,3,JKSL)*EXP (ZPHI)
- ZUB =PU(JL,4,JKSL)*EXP (2.*ZPSI)
- ELSE
- ZUA =PU(JL,3,JKSL)
- ZUB =PU(JL,4,JKSL)
- END IF
- ZV(JL,3,JKSL)=ZV(JL,3,JKSL+1)+ZUA
- ZV(JL,4,JKSL)=ZV(JL,4,JKSL+1)+ZUB
- 233 CONTINUE
- 234 CONTINUE
- END IF
-C
- IF (IO3 .NE.0) THEN
- DO 236 JKSL=KGL,1,-1
- DO 235 JL=KIDIA,KFDIA
- IF (LPTDEP) THEN
-*MNH ZTX =ZTAVSL(JL,JKSL)-TREF
- ZTX =ZTAVSL(JL,JKSL)-XTREF
- ZTX2=ZTX*ZTX
-*MNH ZPHI=RODWAL(3,INO3 )*ZTX+RODWAL(4,INO3 )*ZTX2
- ZPHI=XRODWAL(3,INO3 )*ZTX+XRODWAL(4,INO3 )*ZTX2
-*MNH ZPSI=RODWAL(5,INO3 )*ZTX+RODWAL(6,INO3 )*ZTX2
- ZPSI=XRODWAL(5,INO3 )*ZTX+XRODWAL(6,INO3 )*ZTX2
-*MNH
- ZUA =PU(JL,5,JKSL)*EXP (ZPHI)
- ZUB =PU(JL,6,JKSL)*EXP (2.*ZPSI)
- ELSE
- ZUA =PU(JL,5,JKSL)
- ZUB =PU(JL,6,JKSL)
- END IF
- ZV(JL,5,JKSL)=ZV(JL,5,JKSL+1)+ZUA
- ZV(JL,6,JKSL)=ZV(JL,6,JKSL+1)+ZUB
- 235 CONTINUE
- 236 CONTINUE
- END IF
-C
- IF (ICNT.NE.0) THEN
- DO 238 JKSL=KGL,1,-1
- DO 237 JL=KIDIA,KFDIA
- IF (LPTDEP) THEN
- ZFACTC= 6.08*(296./ZTAVSL(JL,JKSL)-1.)
- ZUA =PU(JL,7,JKSL)*EXP (ZFACTC)
- ZUB =PU(JL,8,JKSL)
- ELSE
- ZUA =PU(JL,7,JKSL)
- ZUB =PU(JL,8,JKSL)
- END IF
- ZV(JL,11,JKSL)=ZV(JL,11,JKSL+1)+ZUA
- ZV(JL,12,JKSL)=ZV(JL,12,JKSL+1)+ZUB
- 237 CONTINUE
- 238 CONTINUE
- END IF
-C
- IF (IN2O.NE.0) THEN
- DO 242 JKSL=KGL,1,-1
- DO 241 JL=KIDIA,KFDIA
- IF (LPTDEP) THEN
-*MNH ZTX =ZTAVSL(JL,JKSL)-TREF
- ZTX =ZTAVSL(JL,JKSL)-XTREF
- ZTX2=ZTX*ZTX
-*MNH ZPHI=RODWAL(3,INN2O)*ZTX+RODWAL(4,INN2O)*ZTX2
- ZPHI=XRODWAL(3,INN2O)*ZTX+XRODWAL(4,INN2O)*ZTX2
-*MNH ZPSI=RODWAL(5,INN2O)*ZTX+RODWAL(6,INN2O)*ZTX2
- ZPSI=XRODWAL(5,INN2O)*ZTX+XRODWAL(6,INN2O)*ZTX2
-*MNH
- ZUA =PU(JL,3,JKSL)*EXP (ZPHI) *PCMN2O/PCMCO2
- ZUB =PU(JL,4,JKSL)*EXP (2.*ZPSI)*PCMN2O/PCMCO2
- ELSE
- ZUA =PU(JL,3,JKSL)*PCMN2O/PCMCO2
- ZUB =PU(JL,4,JKSL)*PCMN2O/PCMCO2
- END IF
- ZV(JL,7,JKSL)=ZV(JL,7,JKSL+1)+ZUA
- ZV(JL,8,JKSL)=ZV(JL,8,JKSL+1)+ZUB
- 241 CONTINUE
- 242 CONTINUE
- END IF
-C
- IF (ICH4.NE.0) THEN
- DO 244 JKSL=KGL,1,-1
- DO 243 JL=KIDIA,KFDIA
- IF (LPTDEP) THEN
-*MNH ZTX =ZTAVSL(JL,JKSL)-TREF
- ZTX =ZTAVSL(JL,JKSL)-XTREF
- ZTX2=ZTX*ZTX
-*MNH ZPHI=RODWAL(3,INCH4)*ZTX+RODWAL(4,INCH4)*ZTX2
- ZPHI=XRODWAL(3,INCH4)*ZTX+XRODWAL(4,INCH4)*ZTX2
-*MNH ZPSI=RODWAL(5,INCH4)*ZTX+RODWAL(6,INCH4)*ZTX2
- ZPSI=XRODWAL(5,INCH4)*ZTX+XRODWAL(6,INCH4)*ZTX2
-*MNH
- ZUA =PU(JL,3,JKSL)*EXP (ZPHI) *PCMCH4/PCMCO2
- ZUB =PU(JL,4,JKSL)*EXP (2.*ZPSI)*PCMCH4/PCMCO2
- ELSE
- ZUA =PU(JL,3,JKSL)*PCMCH4/PCMCO2
- ZUB =PU(JL,4,JKSL)*PCMCH4/PCMCO2
- END IF
- ZV(JL, 9,JKSL)=ZV(JL, 9,JKSL+1)+ZUA
- ZV(JL,10,JKSL)=ZV(JL,10,JKSL+1)+ZUB
- 243 CONTINUE
- 244 CONTINUE
- END IF
-C
-C IF (NIMP.LE.2) THEN
-C WRITE (NULOUT,9244) KCABS,KH2O,KCO2,KO3,KCNT,KN2O,KCH4,KCO
-C * ,KC11,KC12,KCFC
-C * ,JWVN,IH2O,ICO2,IO3,ICNT,IN2O,ICH4,ICO,IC11,IC12,ICFC
-C WRITE (NULOUT,9245) KIDIA,(ZV(KIDIA,JABS,1),JABS=1,KUABS)
-C WRITE (NULOUT,9245) KFDIA,(ZV(KFDIA,JABS,1),JABS=1,KUABS)
-C END IF
-C
-C
-C
-C* 2.5 COMPUTES PLANCK FUNCTIONS
-C
- 250 CONTINUE
-C
- INDPLK=1
- DO 253 JK=1,KLEV
- DO 251 JL=KIDIA,KFDIA
- ZTI(JL)=PT(JL,JK)
- ZTI2(JL)=PTAVE(JL,JK)
- 251 CONTINUE
-C
- CALL POLPLK (KIDIA,KFDIA,KLON,INDPLK,ZTI ,ZRES )
- CALL POLPLK (KIDIA,KFDIA,KLON,INDPLK,ZTI2,ZRES2)
-C
- DO 252 JL=KIDIA,KFDIA
- ZBLEV(JL,JK)=ZRES(JL)
- ZBLAY(JL,JK)=ZRES2(JL)
- ZBINT(JL,JK)=ZBINT(JL,JK)+ZRES(JL)
- 252 CONTINUE
-C IF (NIMP.EQ.0) THEN
-C JL=KIDIA
-C print 9252,0,PT(JL,JK),PTAVE(JL,JK)
-C $ ,ZBLAY(JL,JK),ZBLEV(JL,JK),ZBINT(JL,JK)
-C 9252 FORMAT(1X,I3,2F8.3,3F14.7)
-C END IF
- 253 CONTINUE
-C
- DO 254 JL=KIDIA,KFDIA
- ZTI2(JL)=PT(JL,1)+PDT0(JL)
- ZTI (JL)=PT(JL,KLEV+1)
- 254 CONTINUE
-C
- CALL POLPLK (KIDIA,KFDIA,KLON,INDPLK,ZTI2,ZBSUR)
- CALL POLPLK (KIDIA,KFDIA,KLON,INDPLK,ZTI ,ZRES )
-C
- DO 255 JL=KIDIA,KFDIA
- ZBLEV(JL,KLEV+1)=ZRES(JL)
- ZBINT(JL,KLEV+1)=ZBINT(JL,KLEV+1)+ZRES(JL)
-C ZBSUI(JL)=ZBSUI(JL)+ZBSUR(JL)
- 255 CONTINUE
-C IF (NIMP.EQ.0) THEN
-C JL=KIDIA
-C print 9255, JWVN,ZTI(JL),ZTI2(JL)
-C $ ,ZBSUR(JL),ZBSUI(JL),ZBLEV(JL,KLEV+1),ZBINT(JL,KLEV+1)
-C 9255 FORMAT(1X,I3,2F8.3,4F14.7)
-C END IF
-C
- DO 257 JK = 1 , KLEV
- JK2 = 2 * JK
- JK1 = JK2 - 1
- DO 256 JL = KIDIA,KFDIA
- ZDBSL(JL,JK1) = ZBLAY(JL,JK ) - ZBLEV(JL,JK)
- ZDBSL(JL,JK2) = ZBLEV(JL,JK+1) - ZBLAY(JL,JK)
- ZCDBSL(JL,JK1)= ZCDBSL(JL,JK1) + ZDBSL(JL,JK1)
- ZCDBSL(JL,JK2)= ZCDBSL(JL,JK2) + ZDBSL(JL,JK2)
- 256 CONTINUE
-C IF (NIMP.EQ.0) THEN
-C JL=KIDIA
-C print 9256,JK,PTAVE(JL,JK),ZDBSL(JL,JK1),ZDBSL(JL,JK2)
-C $ ,ZCDBSL(JL,JK1),ZCDBSL(JL,JK2)
-C 9256 FORMAT(1X,I3,F8.3,4F14.7)
-C END IF
- 257 CONTINUE
- 259 CONTINUE
-C IF (NIMP.EQ.0) print *,' SPECTR after 259 '
-C
-C
-C
-C* 2.6 CALL VERTICAL INTEGRATION
-C
- 260 CONTINUE
-C
- CALL VERTI
- I ( KIDIA,KFDIA,KLON,KLEV,KGL,KCABS,KNG1,KUABS,KCONF
- I , KH2O,KCO2,KO3,KCNT,KN2O,KCH4,KCO,KC11,KC12,KCFC
- I , IBOT,ITOP,IVDIS
- L , LPVOIGT
- R , PANGLE,ZBLEV,ZBSUR,ZCNTRB,ZDZ,PEM0
- R , ZV,ZDBSL,ZWVN
- R , ZFDC,ZFUC )
-C
- DO 263 JK1=1,KLEV+1
- DO 262 JK2=1,KLEV+1
- DO 261 JL=KIDIA,KFDIA
- PCNTRB(JL,JK1,JK2)=PCNTRB(JL,JK1,JK2)+ZCNTRB(JL,JK1,JK2)
- 261 CONTINUE
-
-C IF (NIMP.EQ.0) THEN
-C JL=KIDIA
-C PRINT 9261,JK1,JK2,ZCNTRB(JL,JK1,JK2),PCNTRB(JL,JK1,JK2)
-C 9261 FORMAT(1X,2I4,2E15.8)
-C END IF
- 262 CONTINUE
- 263 CONTINUE
-C
- DO 265 JK=1,KLEV+1
- DO 264 JL=KIDIA,KFDIA
- ZFUT(JL,JK)=0.
- ZFDT(JL,JK)=0.
- ZFUT(JL,JK)=ZFUC(JL,JK)
- ZFDT(JL,JK)=ZFDC(JL,JK)
- 264 CONTINUE
- 265 CONTINUE
-C IF (NIMP.EQ.0) print *,' SPECTR after 265 '
-C
-C
-C ------------------------------------------------------------------
-C
-C* 3. INTRODUCE CLOUD EFFECTS (ON A SPECTRAL BASIS)
-C
- 300 CONTINUE
-C
- IF (KCONF.EQ.0 .OR. KCONF.EQ.1) THEN
-C
-
- CALL CLOUD
- I ( KIDIA , KFDIA, KLON , KLEV
- I , KCLOUD, KOVLP
- R , ZBSUR , ZCLDLD, ZCLDLU, ZCNTRB, ZFUC, ZFDC, ZBLEV, PEM0
- R , ZFUT , ZFDT
- S )
-C
-C
-C
- END IF
-C
-C
-C
-C
-C ------------------------------------------------------------------
-C
-C* 4. FILLING-UP BROAD-BAND FLUXES ARRAYS
-C
- 400 CONTINUE
-C
- ILEV=0
- IF (KCONF.EQ.0) THEN
- IVSTP=1
- ELSE
- IVSTP=KLEV
- END IF
- DO JL=KIDIA,KFDIA
- PRADC(JL,JWVN)=ZFUC(JL,KLEV+1)
- PRADT(JL,JWVN)=ZFUT(JL,KLEV+1)
- END DO
-C
-C
-C
-C
-C
-C
-C
-C
-C 4.9 END OF SPECTRAL LOOP
-C
-C***
- 499 CONTINUE
-
- 9101 FORMAT (1X,'*VERTI* IMPROPER CONFIGURATION:',I2)
- 9201 FORMAT (1X,'*SPECTR* NULL ABSORBER AMOUNTS IUX= ',I2,' IUY= ',I2)
- 9244 FORMAT (1X,'REQUIRED:',11I3,' JWVN= ',I3,' ACTIVE:',10I3)
- 9245 FORMAT (1X,I3,14E9.3)
-C
-C ------------------------------------------------------------------
-C
- RETURN
- END
- SUBROUTINE POLPLK
- I ( KIDIA,KFDIA,KLON,KINDT
- R , PT
- R , PRES
- S )
-C
-C**** *POLPLK* - COMPUTES PLANCK FUNCTIONS FROM POLYNOMIAL EXPANSION
-C
-C** INTERFACE
-C ---------
-C *POLPLK* IS CALLED BY *SPECTR*
-C
-C ARGUMENTS
-C ---------
-C === INPUTS ===
-C KIDIA : START OF VECTOR
-C KFDIA : END OF VECTOR
-C KLON : TOTAL LENGTH OF VECTOR
-C KINDT : 1. PLANCK FUNCTION 2. DERIVATIVE W.R.T. TEMPERATURE
-C PT : TEMPERATURE
-C === OUTPUTS ===
-C PRES : B(T) OR DB(T)/DT
-C
-C METHOD
-C ------
-C
-C REFERENCE
-C ---------
-C
-C AUTHOR
-C ------
-C JEAN-JACQUES MORCRETTE *ECMWF* 96/12/20
-C
-C MODIFICATIONS
-C -------------
-C
-C ------------------------------------------------------------------
-*MNH
- USE MODD_RAD_TRANSF
-*MNH
- !include 'param.h'
-*MNH INTEGER JNINT,JUABS,JUAMO,JV2,JV3,JV10
-*MNH PARAMETER (JNINT=225,JUABS=14,JUAMO=8,JV2=2,JV3=3,JV10=10)
- !include 'yomgos.h'
-*MNH real RT1(2),WG1(2)
-*MNH COMMON /YOMGOS/ RT1,WG1
- !include 'yomio.h'
-*MNH integer IMP,NIMP,NULOUT,NULINA,NULNAM
-*MNH COMMON /YOMIO/ IMP,NIMP,NULOUT,NULINA,NULNAM
- !include 'yomspe.h'
-*MNH integer N_INT,NA
-*MNH real TREF,TPOLY
-*MNH real WNU(JV2),RODWAL(6,8),POLPLCK(6,2),WVNA(JNINT),WVNB(JNINT),
-*MNH & RALPHA,RPI,RAIRM,RH2OM,RCO2M,RO3M,RN2OM,RCOM,RCH4M,RO2M,
-*MNH & RF11M,RF12M
-*MNH COMMON /YOMSPEI/ N_INT,NA,TREF,TPOLY
-*MNH COMMON /YOMSPER/ WNU,RODWAL,POLPLCK,WVNA,WVNB,RALPHA,RPI,
-*MNH & RAIRM,RH2OM,RCO2M,RO3M,RN2OM,RCOM,RCH4M,RO2M,RF11M,RF12M
-C ------------------------------------------------------------------
-C
-C 0.1 ARGUMENTS
-C
- REAL PT(KLON),PRES(KLON)
-C
-C ------------------------------------------------------------------
-C
-C 0.2 LOCAL ARRAYS
-C
- REAL ZT(KLON)
-C
-C ------------------------------------------------------------------
-C
-C 1.
-C
- 100 CONTINUE
-C
- DO 101 JL=KIDIA,KFDIA
-*MNH ZT(JL)=(PT(JL)-TPOLY)/TPOLY
- ZT(JL)=(PT(JL)-XTPOLY)/XTPOLY
-*MNH PRES(JL)=POLPLCK(6,KINDT)
- PRES(JL)=XPOLPLCK(6,KINDT)
-*MNH
- 101 CONTINUE
-C
- DO 103 JPOL=5,1,-1
- DO 102 JL=KIDIA,KFDIA
-*MNH PRES(JL)=PRES(JL)*ZT(JL)+POLPLCK(JPOL,KINDT)
- PRES(JL)=PRES(JL)*ZT(JL)+XPOLPLCK(JPOL,KINDT)
-*MNH
- 102 CONTINUE
- 103 CONTINUE
-C
-C ------------------------------------------------------------------
-C
- RETURN
- END
- SUBROUTINE VERTI
- I ( KIDIA, KFDIA, KLON , KLEV, KGL , KCABS, KNG1, KUABS, KCONF
- I , KH2O , KCO2 , KO3 , KCNT, KN2O, KCH4
- I , KCO , KC11 , KC12 , KCFC
- I , KBOT , KTOP , KVDIS
- L , LPVOIGT
- R , PANGLE,PB ,PBSUR,PCNTRB, PDZ, PEM0 , PV , PDBSL, PWVN
- R , PFDC ,PFUC
- S )
-C
-C**** *VERTI* - PERFORMS THE VERTICAL INTEGRATION
-C
-C** INTERFACE
-C ---------
-C *VERTI* IS CALLED BY *SPECTR*
-C
-C ARGUMENTS
-C ---------
-C === INPUTS ===
-C I KIDIA : START OF VECTOR
-C I KFDIA : END OF VECTOR
-C I KLON : TOTAL LENGTH OF VECTOR
-C I KLEV : NUMBER OF FULL-LEVELS (LAYERS)
-C I KGL : NUMBER OF SUB-LAYERS IN VERTICAL INTEGRATION
-C I KCABS : CONFIGURATION INDEX FOR ABSORBERS
-C L LPVOIGT : .T. IF VOIGT PROFILE IS ACCOUNTED FOR
-C R PANGLE : 1./COS(VIEWING ANGLE) OR DIFFUSIVITY FACTOR
-C R PB : PLANCK FUNCTION ON HALF-LEVELS
-C R PBSUR : SURFACE PLANCK FUNCTION
-C R PCNTRB : ENERGY EXCHANGE MATRIX
-C R PDZ : LAYER THICKNESS
-C
-C === OUTPUTS ===
-C PFDC : DOWNWARD CLEAR-SKY FLUXES
-C PFUC : UPWARD CLEAR-SKY FLUXES
-C
-C METHOD
-C ------
-C
-C REFERENCE
-C ---------
-C
-C AUTHOR
-C ------
-C JEAN-JACQUES MORCRETTE *ECMWF* 92/12/04
-C
-C MODIFICATIONS
-C -------------
-C
-C ------------------------------------------------------------------
-*MNH
- USE MODD_RAD_TRANSF
-*MNH
- LOGICAL LPVOIGT
- !include 'param.h'
-*MNH INTEGER JNINT,JUABS,JUAMO,JV2,JV3,JV10
-*MNH PARAMETER (JNINT=225,JUABS=14,JUAMO=8,JV2=2,JV3=3,JV10=10)
- !include 'yomgos.h'
-*MNH real RT1(2),WG1(2)
-*MNH COMMON /YOMGOS/ RT1,WG1
- !include 'yomio.h'
-*MNH integer IMP,NIMP,NULOUT,NULINA,NULNAM
-*MNH COMMON /YOMIO/ IMP,NIMP,NULOUT,NULINA,NULNAM
- !include 'yomspe.h'
-*MNH integer N_INT,NA
-*MNH real TREF,TPOLY
-*MNH real WNU(JV2),RODWAL(6,8),POLPLCK(6,2),WVNA(JNINT),WVNB(JNINT),
-*MNH & RALPHA,RPI,RAIRM,RH2OM,RCO2M,RO3M,RN2OM,RCOM,RCH4M,RO2M,
-*MNH & RF11M,RF12M
-*MNH COMMON /YOMSPEI/ N_INT,NA,TREF,TPOLY
-*MNH COMMON /YOMSPER/ WNU,RODWAL,POLPLCK,WVNA,WVNB,RALPHA,RPI,
-*MNH & RAIRM,RH2OM,RCO2M,RO3M,RN2OM,RCOM,RCH4M,RO2M,RF11M,RF12M
-C ------------------------------------------------------------------
-C
-C 0.1 ARGUMENTS
-C
- REAL
- * PANGLE(KLON)
- * , PB(KLON,KLEV+1) , PBSUR(KLON)
- * , PCNTRB(KLON,KLEV+1,KLEV+1)
- * , PDT0(KLON) , PDZ(KLON,KLEV)
-*MNH * , PEM0(KLON) , PV(KLON,JUABS,KGL+1)
- * , PEM0(KLON) , PV(KLON,JPUABS,KGL+1)
-CBUG * , PDBSL(KLON,2*KLEV+1) , PXT(KLON,3,3*KLEV+1)
- * , PDBSL(KLON,2*KLEV) , PXT(KLON,3,3*KLEV+1)
-C
- REAL
- * PFDC(KLON,KLEV+1) , PFUC(KLON,KLEV+1)
-C
-C ------------------------------------------------------------------
-C
-C 0.2 LOCAL ARRAYS
-C
- INTEGER
- * INDCL(KLON,KLEV+1)
-C
- REAL
- * ZDISD(KLON),ZDISU(KLON)
- * , ZCNSU(KLON),ZCNTP(KLON)
- * , ZDR(KLON),ZSR(KLON),ZDG(KLON)
- * , ZUG(KLON),ZBGND(KLON)
- * , ZTR(KLON),ZUR(KLON),ZFU(KLON)
- * , ZFD(KLON),ZFD1(KLON)
- REAL
- *ZDAU0(KLON),ZDAU1(KLON),ZDAU2(KLON), ZDAU3(KLON),ZDAU4(KLON)
- *,ZDAU5(KLON),ZDAU6(KLON),ZDAU7(KLON),ZDAU8(KLON),ZDAU9(KLON)
- *,ZSAU0(KLON),ZSAU1(KLON),ZSAU2(KLON),ZSAU3(KLON),ZSAU4(KLON)
- *,ZSAU5(KLON),ZSAU6(KLON),ZSAU7(KLON),ZSAU8(KLON),ZSAU9(KLON)
- *,ZTAU0(KLON),ZTAU1(KLON),ZTAU2(KLON),ZTAU3(KLON),ZTAU4(KLON)
- *,ZTAU5(KLON),ZTAU6(KLON),ZTAU7(KLON),ZTAU8(KLON),ZTAU9(KLON)
- *,ZUAU0(KLON),ZUAU1(KLON),ZUAU2(KLON),ZUAU3(KLON),ZUAU4(KLON)
- *,ZUAU5(KLON),ZUAU6(KLON),ZUAU7(KLON),ZUAU8(KLON),ZUAU9(KLON)
-C ------------------------------------------------------------------
-C
-C* 1. INITIALIZATION
-C
- 100 CONTINUE
-C
-c PRINT *,' Verti '
-C IF (NIMP.EQ.0) STOP
-
-C
- DO 103 JK1=1,KLEV+1
- DO 102 JK2=1,KLEV+1
- DO 101 JL=KIDIA,KFDIA
- PCNTRB(JL,JK1,JK2)=0.
- 101 CONTINUE
- 102 CONTINUE
- 103 CONTINUE
-C IF (NIMP.EQ.0) print *,' VERTI after 103 '
-
-C
-C
-C
-C ------------------------------------------------------------------
-C
-C* 2. VERTICAL INTEGRATION USING GAUSS QUADRATURE
-C
- 200 CONTINUE
-C
-C IF (NIMP.EQ.0) print *,' Vertical integration '
- DO 249 JK=KBOT,KTOP,KVDIS
- ISL=(JK-1)*(KNG1+1)+1
- IL12 = 2 * (JK - 1)
-C
- DO 201 JL=KIDIA,KFDIA
- ZDISD(JL)=0.
- ZDISU(JL)=0.
- ZDR (JL)=1.
- ZSR (JL)=1.
- ZTR (JL)=1.
- ZUR (JL)=1.
- PFUC(JL,JK)=0.
- PFDC(JL,JK)=0.
- 201 CONTINUE
-C
-C
-C* 2.1 DOWNWARD FLUXES
-C
- 210 CONTINUE
-C
- IF (JK.NE.KLEV+1) THEN
-C
- DO 218 JK1=JK,KLEV
- ISLX=(JK1-1)*(KNG1+1)+1
- ID12 = 2 * (JK1 - 1)
-
- DO 211 JL=KIDIA,KFDIA
- ZDG(JL)=0.
- 211 CONTINUE
- DO 214 JG=1,KNG1
- ISLXG=ISLX+JG
- IDS = ID12 + JG
-
- DO 212 JL=KIDIA,KFDIA
- ZDAU0(JL)=0.
- ZDAU1(JL)=0.
- ZDAU2(JL)=0.
- ZDAU3(JL)=0.
- ZDAU4(JL)=0.
- ZDAU5(JL)=0.
- ZDAU6(JL)=0.
- ZDAU7(JL)=0.
- ZDAU8(JL)=0.
- ZDAU9(JL)=0.
- 212 CONTINUE
-C
-C IF (NIMP.EQ.0) print 9212,JK,ISL,JK1,JG,ISLXG
-C 9212 FORMAT(1X,' Downward JK,ISL,JK1,JG,ISLXG ',5I4)
- IF (KCNT.EQ.1) THEN
- CALL CNTINU (KIDIA,KFDIA,KLON, KLEV, ISL,ISLXG, KCABS
- R , PANGLE,PV,PWVN
- R , ZDAU0 )
- END IF
- IF (KH2O.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISL,ISLXG, 1 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZDAU1 )
- END IF
- IF (KCO2.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISL,ISLXG, 2 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZDAU2 )
- END IF
- IF (KO3 .EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISL,ISLXG, 3 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZDAU3 )
- END IF
- IF (KN2O.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISL,ISLXG, 4 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZDAU4 )
- END IF
- IF (KCH4.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISL,ISLXG, 5 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZDAU5 )
- END IF
- IF (KC11.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISL,ISLXG, 6 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZDAU6 )
- END IF
- IF (KC12.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISL,ISLXG, 7 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZDAU7 )
- END IF
- IF (KCFC.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISL,ISLXG, 8 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZDAU8 )
- END IF
-C
- DO 213 JL=KIDIA,KFDIA
- ZDR(JL)=EXP (-ZDAU0(JL)-ZDAU1(JL)-ZDAU2(JL)-ZDAU3(JL)
- * -ZDAU4(JL)-ZDAU5(JL)-ZDAU6(JL)-ZDAU7(JL)-ZDAU8(JL))
-*MNH ZDG(JL)=ZDG(JL)+PDBSL(JL,IDS)*ZDR(JL)*WG1(JG)
- ZDG(JL)=ZDG(JL)+PDBSL(JL,IDS)*ZDR(JL)*XWG1(JG)
-*MNH
- 213 CONTINUE
-
-C IF (NIMP.EQ.0) THEN
-C JL=KIDIA
-C print 9213,JK,JK1,JG,IDS,ZDR(JL),PDBSL(JL,IDS),ZDG(JL)
-C 9213 format(1x,'Dn',4I4,F8.5,2F14.7)
-C END IF
- 214 CONTINUE
-C
- IK1P1=JK1+1
-C
- DO 215 JL=KIDIA,KFDIA
- PCNTRB(JL,JK,IK1P1)=ZDG(JL)
- ZDISD(JL)=ZDISD(JL)+ZDG(JL)
- 215 CONTINUE
-C
- 218 CONTINUE
- END IF
-C
-C
-C
-C
-C* 2.2 UPWARD FLUXES
-C
- 220 CONTINUE
-C
- IF (JK.NE.1) THEN
-C
- DO 228 JK1= JK-1,1,-1
- ISLX=(JK1-1)*(KNG1+1)+1
- IU12 = 2 * (JK1 - 1)
-
- DO 221 JL=KIDIA,KFDIA
- ZUG(JL)=0.
- 221 CONTINUE
- DO 224 JG=1,KNG1
- ISLXG=ISLX+JG
- IUS = IU12 + JG
-
- DO 222 JL=KIDIA,KFDIA
- ZUAU0(JL)=0.
- ZUAU1(JL)=0.
- ZUAU2(JL)=0.
- ZUAU3(JL)=0.
- ZUAU4(JL)=0.
- ZUAU5(JL)=0.
- ZUAU6(JL)=0.
- ZUAU7(JL)=0.
- ZUAU8(JL)=0.
- ZUAU9(JL)=0.
- 222 CONTINUE
-C
-C IF (NIMP.EQ.0) print 9222,JK,ISL,JK1,JG,ISLXG
- 9222 FORMAT(1X,' Upward JK,ISL,JK1,JG,ISLXG ',5I4)
- IF (KCNT.EQ.1) THEN
- CALL CNTINU (KIDIA,KFDIA,KLON, KLEV, ISLXG,ISL, KCABS
- R , PANGLE,PV,PWVN
- R , ZUAU0 )
- END IF
- IF (KH2O.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISLXG,ISL, 1 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZUAU1 )
- END IF
- IF (KCO2.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISLXG,ISL, 2 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZUAU2 )
- END IF
- IF (KO3 .EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISLXG,ISL, 3 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZUAU3 )
- END IF
- IF (KN2O.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISLXG,ISL, 4 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZUAU4 )
- END IF
- IF (KCH4.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISLXG,ISL, 5 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZUAU5 )
- END IF
- IF (KC11.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISLXG,ISL, 6 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZUAU6 )
- END IF
- IF (KC12.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISLXG,ISL, 7 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZUAU7 )
- END IF
- IF (KCFC.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISLXG,ISL, 8 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZUAU8 )
- END IF
-C
- DO 223 JL=KIDIA,KFDIA
- ZUR(JL)=EXP (-ZUAU0(JL)-ZUAU1(JL)-ZUAU2(JL)-ZUAU3(JL)
- * -ZUAU4(JL)-ZUAU5(JL)-ZUAU6(JL)-ZUAU7(JL)-ZUAU8(JL))
-*MNH ZUG(JL)=ZUG(JL)+PDBSL(JL,IUS)*ZUR(JL)*WG1(JG)
- ZUG(JL)=ZUG(JL)+PDBSL(JL,IUS)*ZUR(JL)*XWG1(JG)
-*MNH
- 223 CONTINUE
-C IF (NIMP.EQ.0) THEN
-C JL=KIDIA
-C print 9223,JK,JK1,JG,IUS,ZUR(JL),PDBSL(JL,IDS),ZUG(JL)
-C 9223 format(1x,'Up',4I4,F8.5,2F14.7)
-C END IF
- 224 CONTINUE
-C
- DO 225 JL=KIDIA,KFDIA
- PCNTRB(JL,JK,JK1 )=ZUG(JL)
- ZDISU(JL)=ZDISU(JL)+ZUG(JL)
- 225 CONTINUE
-C
- 228 CONTINUE
- END IF
-C
-C
-C
-C
-C
-C
-C* 2.3 EXCHANGE WITH THE TOP OF THE ATMOSPHERE
-C
- 230 CONTINUE
-C
- IF (JK.NE.KLEV+1) THEN
-C
- DO 231 JL=KIDIA,KFDIA
- ZTAU0(JL)=0.
- ZTAU1(JL)=0.
- ZTAU2(JL)=0.
- ZTAU3(JL)=0.
- ZTAU4(JL)=0.
- ZTAU5(JL)=0.
- ZTAU6(JL)=0.
- ZTAU7(JL)=0.
- ZTAU8(JL)=0.
- ZTAU9(JL)=0.
- 231 CONTINUE
-C
-C IF (NIMP.EQ.0) print 9231,JK,ISL,KGL+1
- 9231 FORMAT(1X,' Top JK,ISL,KGL+1 ',5I4)
- IF (KCNT.EQ.1) THEN
- CALL CNTINU (KIDIA,KFDIA,KLON, KLEV, ISL,KGL+1, KCABS
- R , PANGLE,PV,PWVN
- R , ZTAU0 )
- END IF
- IF (KH2O.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISL,KGL+1, 1 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZTAU1 )
- END IF
- IF (KCO2.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISL,KGL+1, 2 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZTAU2 )
- END IF
- IF (KO3 .EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISL,KGL+1, 3 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZTAU3 )
- END IF
- IF (KN2O.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISL,KGL+1, 4 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZTAU4 )
- END IF
- IF (KCH4.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISL,KGL+1, 5 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZTAU5 )
- END IF
- IF (KC11.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISL,KGL+1, 6 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZTAU6 )
- END IF
- IF (KC12.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISL,KGL+1, 7 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZTAU7 )
- END IF
- IF (KCFC.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, ISL,KGL+1, 8 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZTAU8 )
- END IF
-C
- DO 232 JL=KIDIA,KFDIA
- ZTR(JL)=EXP (-ZTAU0(JL)-ZTAU1(JL)-ZTAU2(JL)-ZTAU3(JL)
- * -ZTAU4(JL)-ZTAU5(JL)-ZTAU6(JL)-ZTAU7(JL)-ZTAU8(JL))
- 232 CONTINUE
- END IF
-C
- DO 233 JL=KIDIA,KFDIA
- ZCNTP(JL)=ZTR(JL)*PB(JL,KLEV+1)
- ZFD(JL)=ZCNTP(JL)-PB(JL,JK)-ZDISD(JL)
- PFDC(JL,JK)=ZFD(JL)
- 233 CONTINUE
-C IF (NIMP.EQ.0) THEN
-C JL=KIDIA
-C print 9233,JK,ZTR(JL),PB(JL,KLEV+1),ZCNTP(JL),PB(JL,JK),ZDISD(JL)
-C $ ,ZFD(JL)
-C 9233 format(1x,'Xchg Top',I4,F8.5,5F14.7)
-C END IF
-C
- IF (JK.EQ.1) THEN
- DO 234 JL=KIDIA,KFDIA
- ZFD1(JL)=-ZFD(JL)
- 234 CONTINUE
- END IF
-C
-C
-C
-C
-C
-C* 2.4 EXCHANGE WITH THE SURFACE
-C
- 240 CONTINUE
-C
- DO 241 JL=KIDIA,KFDIA
- ZBGND(JL)=PBSUR(JL)*PEM0(JL)+(1.-PEM0(JL))*ZFD1(JL)-PB(JL,1)
-C ZSR(JL)=1.
- 241 CONTINUE
-C IF (NIMP.EQ.0. AND. JK.EQ.1) THEN
-C JL=KIDIA
-C print 9241,PBSUR(JL),PEM0(JL),ZFD1(JL),PB(JL,1),ZBGND(JL)
-C 9241 FORMAT(1X,'Surf ',F12.5,F8.5,3F12.5)
-C END IF
-C
- IF (JK.NE.1) THEN
-C
- DO 242 JL=KIDIA,KFDIA
- ZSAU0(JL)=0.
- ZSAU1(JL)=0.
- ZSAU2(JL)=0.
- ZSAU3(JL)=0.
- ZSAU4(JL)=0.
- ZSAU5(JL)=0.
- ZSAU6(JL)=0.
- ZSAU7(JL)=0.
- ZSAU8(JL)=0.
- ZSAU9(JL)=0.
- 242 CONTINUE
-C
-C IF (NIMP.EQ.0) print 9242,JK,1,ISL
- 9242 FORMAT(1X,' Surface JK,1,ISL ',5I4)
- IF (KCNT.EQ.1) THEN
- CALL CNTINU (KIDIA,KFDIA,KLON, KLEV, 1, ISL, KCABS
- R , PANGLE,PV,PWVN
- R , ZSAU0 )
- END IF
- IF (KH2O.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, 1, ISL, 1 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZSAU1 )
- END IF
- IF (KCO2.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, 1, ISL, 2 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZSAU2 )
- END IF
- IF (KO3 .EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, 1, ISL, 3 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZSAU3 )
- END IF
- IF (KN2O.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, 1, ISL, 4 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZSAU4 )
- END IF
- IF (KCH4.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, 1, ISL, 5 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZSAU5 )
- END IF
- IF (KC11.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, 1, ISL, 6 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZSAU6 )
- END IF
- IF (KC12.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, 1, ISL, 7 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZSAU7 )
- END IF
- IF (KCFC.EQ.1) THEN
- CALL TRANSM (KIDIA,KFDIA,KLON, KLEV, 1, ISL, 8 ,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , ZSAU8 )
- END IF
-C
- DO 243 JL=KIDIA,KFDIA
- ZSR(JL)=EXP (-ZSAU0(JL)-ZSAU1(JL)-ZSAU2(JL)-ZSAU3(JL)
- * -ZSAU4(JL)-ZSAU5(JL)-ZSAU6(JL)-ZSAU7(JL)-ZSAU8(JL))
- 243 CONTINUE
- END IF
-C
- DO 244 JL=KIDIA,KFDIA
- ZCNSU(JL)=ZSR(JL)*ZBGND(JL)
- ZFU(JL)=ZCNSU(JL)+PB(JL,JK)-ZDISU(JL)
- PFUC(JL,JK)=ZFU(JL)
- 244 CONTINUE
-C IF (NIMP.EQ.0) THEN
-C JL=KIDIA
-C print 9244,JK,ZSR(JL),ZBGND(JL),ZCNSU(JL),PB(JL,JK),ZDISU(JL)
-C $ ,ZFU(JL)
-C 9244 format(1x,'Xchg Sur',I4,F8.5,5F14.7)
-C END IF
-C
- 249 CONTINUE
-C
-C ------------------------------------------------------------------
-C
- RETURN
- END
- SUBROUTINE CNTINU (KIDIA,KFDIA,KLON, KLEV, KINF,KSUP, KCABS
- R , PANGLE,PV,PWVN
- R , PTAU )
-C
-C**** *CNTINU* - TRANSMISSION BY WATER VAPOR CONTINUUM
-C
-C** INTERFACE
-C ---------
-C *CNTINU* IS CALLED BY *VERTI*
-C
-C ARGUMENTS
-C ---------
-C === INPUTS ===
-C KIDIA : START OF VECTOR
-C KFDIA : END OF VECTOR
-C KLON : TOTAL LENGTH OF VECTOR
-C KCABS : CONFIGURATION INDEX FOR ABSORBERS
-C KINF : LOWER LEVEL OF LAYER CONSIDERED
-C KSUP : UPPER LEVEL OF LAYER CONSIDERED
-C PANGLE : 1./COS(VIEWING ANGLE) OR DIFFUSITY FACTOR
-C PWVN : WAVENUMBER
-C PV : REDUCED ABSORBER AMOUNTS CUMULATED FROM MODEL TOP
-C === OUTPUTS ===
-C PTAU : OPTICAL THICKNESS DUE TO WATER VAPOR CONTINUUM
-C
-C METHOD
-C ------
-C
-C REFERENCE
-C ---------
-C
-C AUTHOR
-C ------
-C JEAN-JACQUES MORCRETTE *ECMWF* 96/12/20
-C
-C MODIFICATIONS
-C -------------
-C
-C ------------------------------------------------------------------
-*MNH
- USE MODD_RAD_TRANSF
-*MNH
- !include 'param.h'
-*MNH INTEGER JNINT,JUABS,JUAMO,JV2,JV3,JV10
-*MNH PARAMETER (JNINT=225,JUABS=14,JUAMO=8,JV2=2,JV3=3,JV10=10)
- !include 'yomgos.h'
-*MNH real RT1(2),WG1(2)
-*MNH COMMON /YOMGOS/ RT1,WG1
- !include 'yomio.h'
-*MNH integer IMP,NIMP,NULOUT,NULINA,NULNAM
-*MNH COMMON /YOMIO/ IMP,NIMP,NULOUT,NULINA,NULNAM
- !include 'yomrad.h'
-*MNH integer NABS,NATM,NATMS,NSPWV,NTMP1,NTEMP,NCH2O,NCCO2,NCO3,
-*MNH & NCHAN,NH2O,NCO2,NO3,NCNT,NN2O,NCH4,NCO,NC11,NC12,NCFC,NO2
-*MNH real CVCO2,CVN2O,CVCO,CVCH4,CVF11,CVF12,CVO2,FTEMP(JV3),
-*MNH & FCH2O(JV3),FCCO2(JV3),FCO3(JV3),XLIM(JV10),CLIM(JV2)
-*MNH COMMON/YOMRADI/NABS,NATM,NATMS,NSPWV,NTMP1,NTEMP,NCH2O,NCCO2,NCO3,
-*MNH & NCHAN,NH2O,NCO2,NO3,NCNT,NN2O,NCH4,NCO,NC11,NC12,NCFC,NO2
-*MNH COMMON /YOMRADR/CVCO2,CVN2O,CVCO,CVCH4,CVF11,CVF12,CVO2,
-*MNH & FTEMP,FCH2O,FCCO2,FCO3,XLIM,CLIM
- !include 'yomspe.h'
-*MNH integer N_INT,NA
-*MNH real TREF,TPOLY
-*MNH real WNU(JV2),RODWAL(6,8),POLPLCK(6,2),WVNA(JNINT),WVNB(JNINT),
-*MNH & RALPHA,RPI,RAIRM,RH2OM,RCO2M,RO3M,RN2OM,RCOM,RCH4M,RO2M,
-*MNH & RF11M,RF12M
-*MNH COMMON /YOMSPEI/ N_INT,NA,TREF,TPOLY
-*MNH COMMON /YOMSPER/ WNU,RODWAL,POLPLCK,WVNA,WVNB,RALPHA,RPI,
-*MNH & RAIRM,RH2OM,RCO2M,RO3M,RN2OM,RCOM,RCH4M,RO2M,RF11M,RF12M
-C ------------------------------------------------------------------
-C
-C 0.1 ARGUMENTS
-C
-*MNH REAL PANGLE(KLON),PV(KLON,JUABS,3*KLEV+1)
- REAL PANGLE(KLON),PV(KLON,JPUABS,3*KLEV+1)
-C
- REAL PTAU(KLON)
-C
-C ------------------------------------------------------------------
-C
-C 0.2 LOCAL ARRAYS
-C
- REAL ZE(KLON),ZP(KLON),ZTAUE(KLON),ZTAUP(KLON)
- REAL ZCOEF
-C
-C ------------------------------------------------------------------
-C
-C 1.
-C
- DO JL=KIDIA,KFDIA
- PTAU(JL)=0.
- END DO
-C
-*MNH IF (PWVN.GT.CLIM(1) .AND. PWVN.LT.CLIM(2)) THEN
- IF (PWVN.GT.XCLIM(1) .AND. PWVN.LT.XCLIM(2)) THEN
-C
- ZCOEF=4.18 + 5578.*EXP(-7.87e-03*PWVN)
- DO JL=KIDIA,KFDIA
- ZE(JL)=PV(JL,11,KINF)-PV(JL,11,KSUP)
- ZP(JL)=PV(JL,12,KINF)-PV(JL,12,KSUP)
- ZTAUE(JL)=PANGLE(JL)*ZCOEF*ZE(JL)
- ZTAUP(JL)=PANGLE(JL)*ZCOEF*ZP(JL)*0.002
- END DO
-C
- IF (KCABS.EQ.20) THEN
- DO JL=KIDIA,KFDIA
- ZTAUE(JL)=0.
- END DO
- END IF
- IF (KCABS.EQ.21) THEN
- DO JL=KIDIA,KFDIA
- ZTAUP(JL)=0.
- END DO
- END IF
-C
- DO JL=KIDIA,KFDIA
- PTAU(JL)=ZTAUE(JL)+ZTAUP(JL)
- END DO
- END IF
-C
-C ------------------------------------------------------------------
-C
- RETURN
- END
- SUBROUTINE TRANSM
- I ( KIDIA,KFDIA,KLON, KLEV, KINF,KSUP, KABS,KCABS
- L , LPVOIGT
- R , PANGLE,PV,PWVN
- R , PTAU
- S )
-C
-C**** *TRANSM* - COMPUTES TRANSMISSION FUNCTIONS
-C
-C** INTERFACE
-C ---------
-C *TRANSM* IS CALLED BY *VERTI*
-C
-C ARGUMENTS
-C ---------
-C === INPUTS ===
-C KIDIA : START OF VECTOR
-C KFDIA : END OF VECTOR
-C KLON : TOTAL LENGTH OF VECTOR
-C KINF : LOWER LEVEL OF LAYER CONSIDERED
-C KSUP : UPPER LEVEL OF LAYER CONSIDERED
-C KABS : INDEX OF CONSIDERED ABSORBER
-C KCABS : CONFIGURATION INDEX FOR ABSORBERS
-C LPVOIGT : .T. IF VOIGT PROFILE IS ACCOUNTED FOR
-C PANGLE : 1./COS(VIEWING ANGLE) OR DIFFUSITY FACTOR
-C PV : REDUCED ABSORBER AMOUNTS CUMULATED FROM MODEL TOP
-C PWVN : WAVENUMBER
-C === OUTPUTS ===
-C PTAU : OPTICAL THICKNESS DUE TO WATER VAPOR CONTINUUM
-C
-C METHOD
-C ------
-C
-C REFERENCE
-C ---------
-C
-C AUTHOR
-C ------
-C JEAN-JACQUES MORCRETTE *ECMWF* 96/12/20
-C
-C MODIFICATIONS
-C -------------
-C
-C ------------------------------------------------------------------
-*MNH
- USE MODD_RAD_TRANSF
- USE MODD_CST
-*MNH
- !include 'implic.h'
- LOGICAL LPVOIGT
- !include 'param.h'
-*MNH INTEGER JNINT,JUABS,JUAMO,JV2,JV3,JV10
-*MNH PARAMETER (JNINT=225,JUABS=14,JUAMO=8,JV2=2,JV3=3,JV10=10)
-*MNH !include 'yomgos.h'
-*MNH real RT1(2),WG1(2)
-*MNH COMMON /YOMGOS/ RT1,WG1
- !include 'yomio.h'
-*MNH integer IMP,NIMP,NULOUT,NULINA,NULNAM
-*MNH COMMON /YOMIO/ IMP,NIMP,NULOUT,NULINA,NULNAM
- !include 'yomspe.h'
-*MNH integer N_INT,NA
-*MNH real TREF,TPOLY
-*MNH real WNU(JV2),RODWAL(6,8),POLPLCK(6,2),WVNA(JNINT),WVNB(JNINT),
-*MNH & RALPHA,RPI,RAIRM,RH2OM,RCO2M,RO3M,RN2OM,RCOM,RCH4M,RO2M,
-*MNH & RF11M,RF12M
-*MNH COMMON /YOMSPEI/ N_INT,NA,TREF,TPOLY
-*MNH COMMON /YOMSPER/ WNU,RODWAL,POLPLCK,WVNA,WVNB,RALPHA,RPI,
-*MNH & RAIRM,RH2OM,RCO2M,RO3M,RN2OM,RCOM,RCH4M,RO2M,RF11M,RF12M
-C ------------------------------------------------------------------
-C
-C 0.1 ARGUMENTS
-C
-C
-*MNH REAL PANGLE(KLON),PV(KLON,JUABS,3*KLEV+1)
- REAL PANGLE(KLON),PV(KLON,JPUABS,3*KLEV+1)
-C
- REAL PTAU(KLON)
-C
-C ------------------------------------------------------------------
-C
-C 0.2 LOCAL ARRAYS
-C
- REAL ZA(KLON),ZB(KLON),ZC(KLON)
- REAL ZD(KLON),ZF(KLON),ZG(KLON)
- REAL ZAB(KLON),ZSQ(KLON),ZX(KLON)
- REAL ZY(KLON)
-C
-C ------------------------------------------------------------------
-C
-C 1. INITIALIZATION
-C
- 100 CONTINUE
-C
- DO 101 JL=KIDIA,KFDIA
- PTAU(JL)=0.
-c print *,'TRANSM:',JL,PANGLE(JL)
- 101 CONTINUE
-C
-*MNH ZA1=RODWAL(1,KABS)
- ZA1=XRODWAL(1,KABS)
-*MNH ZA2=RODWAL(2,KABS)
- ZA2=XRODWAL(2,KABS)
-*MNH
-c print *,'TRANSM: ',ZA1,ZA2
-C
-C ------------------------------------------------------------------
-C
-C 2. SKIP COMPUTATION IF NO ABSORPTION OR NO ABSORBER
-C
- 200 CONTINUE
-C
- IF (ZA1.EQ.0.) RETURN
-C
- IUX=2*KABS-1
- IUY=IUX+1
-C
- DO 201 JL=KIDIA,KFDIA
- ZX(JL)=PANGLE(JL)*(PV(JL,IUX,KINF)-PV(JL,IUX,KSUP))
- ZY(JL)=PANGLE(JL)*(PV(JL,IUY,KINF)-PV(JL,IUY,KSUP))
-C IF (ZX(JL).EQ.0. .OR. ZY(JL).EQ.0.) THEN
-C PRINT 9201,IUX,IUY,KINF,KSUP
-C print *,'ZX=',ZX(JL),' ZY=',ZY(JL)
-C print *,PV(JL,IUX,KINF),PV(JL,IUX,KSUP)
-C print *,PV(JL,IUY,KINF),PV(JL,IUY,KSUP)
-C print *,'KABS ',kabs
-C print *,'PROFILE NUMBER:',JL,' PANGLE:',PANGLE(JL)
-C STOP
-C END IF
- 201 CONTINUE
-C
-C ------------------------------------------------------------------
-C
-C 3. COMPUTATION DEPEND ON ABSORBER AND LINE PROFILE
-C
- 300 CONTINUE
-C
- IF (KABS.GE.4) GO TO 400
- IF (LPVOIGT) GO TO 600
- GO TO 500
-C
-C ------------------------------------------------------------------
-C
-C 4. GOODY'S STATISTICAL MODEL FOR N2O, CH4, CO
-C
- 400 CONTINUE
-C
- DO 401 JL=KIDIA,KFDIA
- ZSQ(JL)=SQRT (1.+ZA1*ZX(JL)*ZX(JL)/(ZA2*ZY(JL)))
- PTAU(JL)=ZA1*ZX(JL)/ZSQ(JL)
- 401 CONTINUE
-C
- RETURN
-C
-C
-C ------------------------------------------------------------------
-C
-C 5. MALKMUS'S STATISTICAL MODEL FOR H2O, CO2, O3 - LORENTZ
-C
- 500 CONTINUE
-C
- DO 501 JL=KIDIA,KFDIA
- ZSQ(JL)=SQRT (1.+4.*ZA1*ZX(JL)*ZX(JL)/(ZA2*ZY(JL))) - 1.
- PTAU(JL)=ZA2*ZY(JL)*ZSQ(JL)/(2.*ZX(JL))
- 501 CONTINUE
-C
- RETURN
-C
-C
-C ------------------------------------------------------------------
-C
-C 6. MALKMUS'S STATISTICAL MODEL FOR H2O, CO2, O3 - VOIGT
-C
- 600 CONTINUE
-C
- IF (KABS-2.LT.0) GO TO 610
- IF (KABS-2.EQ.0) GO TO 620
- IF (KABS-2.GT.0) GO TO 630
-C
-C 6.1 WATER VAPOUR
-C
- 610 CONTINUE
- ZDELTA=2.00
-*MNH ZALPHA=RALPHA*SQRT(1./RH2OM)
- ZALPHA=XALPHA*SQRT(1./XH2OM)
-*MNH ZALPHA=RALPHA*SQRT(1./RH2OM)
- ZALPHA=XALPHA*SQRT(1./XH2OM)
- GO TO 650
-C
-C
-C 6.2 CARBON DIOXIDE
-C
- 620 CONTINUE
- ZDELTA=0.75
-*MNH ZALPHA=RALPHA*SQRT(1./RCO2M)
- ZALPHA=XALPHA*SQRT(1./XCO2M)
-*MNH
- GO TO 650
-C
-C
-C 6.3 OZONE
-C
- 630 CONTINUE
- ZDELTA=0.25
-*MNH ZALPHA=RALPHA*SQRT(1./RO3M)
- ZALPHA=XALPHA*SQRT(1./XO3M)
-*MNH GO TO 650
-C
-C 6.5 APPROXIMATE TREATMENT OF VOIGT LINE A LA FELS (1979)
-C
- 650 CONTINUE
-C
- ZALPHD=ZALPHA*PWVN
- DO 651 JL=KIDIA,KFDIA
- ZA(JL)=ZA1*ZX(JL)
-*MNH ZB(JL)=ZA2*ZY(JL)/(RPI*RPI*ZX(JL))
- ZB(JL)=ZA2*ZY(JL)/(XPI*XPI*ZX(JL))
-*MNH
- ZAB(JL)=ZA(JL)*ZB(JL)
- ZC(JL)=4.*ZB(JL) + 1.4*ZALPHD/ZDELTA
- ZD(JL)=0.5-ZB(JL)/ZC(JL)
- ZSQ(JL)=SQRT (ZAB(JL))
- ZF(JL)=ZSQ(JL) * ATAN( ZSQ(JL)/ZC(JL) )
- ZG(JL)=1. + ZA(JL)*ZD(JL)/ZC(JL)
- PTAU(JL)=4.*ZF(JL)
- * +2.*ZC(JL)*LOG(ZG(JL)/(1.+ZAB(JL)/(ZC(JL)*ZC(JL))))
- 651 CONTINUE
-C
-C ------------------------------------------------------------------
-C
- 9201 FORMAT (1X,'*TRANSM* NULL ABSORBER AMOUNTS IUX= ',I2,' IUY= ',I2
- *,' BETWEEN LEVELS',I3,' AND',I3)
-C
-C ------------------------------------------------------------------
-C
- RETURN
- END
- SUBROUTINE CLOUD
- I ( KIDIA , KFDIA, KLON , KLEV
- I , KCLOUD, KOVLP
- R , PBSUR , PCLDLD,PCLDLU , PCNTRB, PFUC, PFDC, PBLEV, PEM0
- R , PFUT , PFDT
- S )
-C
-C**** *CLOUD* - INTRODUCES CLOUD EFFECT ON RADIATION FIELDS
-C
-C** INTERFACE
-C ---------
-C *CLOUD* IS CALLED BY *SPECTR*
-C
-C ARGUMENTS
-C ---------
-C === INPUTS ===
-C === OUTPUTS ===
-C
-C METHOD
-C ------
-C
-C REFERENCE
-C ---------
-C
-C AUTHOR
-C ------
-C JEAN-JACQUES MORCRETTE *ECMWF* 96/12/20
-C
-C MODIFICATIONS
-C -------------
-C
-C ------------------------------------------------------------------
-*MNH
- USE MODD_RAD_TRANSF
-*MNH
- !include 'param.h'
-*MNH INTEGER JNINT,JUABS,JUAMO,JV2,JV3,JV10
-*MNH PARAMETER (JNINT=225,JUABS=14,JUAMO=8,JV2=2,JV3=3,JV10=10)
- !include 'yomgos.h'
-*MNH real RT1(2),WG1(2)
-*MNH COMMON /YOMGOS/ RT1,WG1
- !include 'yomio.h'
-*MNH integer IMP,NIMP,NULOUT,NULINA,NULNAM
-*MNH COMMON /YOMIO/ IMP,NIMP,NULOUT,NULINA,NULNAM
- !include 'yomrad.h'
-*MNH integer NABS,NATM,NATMS,NSPWV,NTMP1,NTEMP,NCH2O,NCCO2,NCO3,
-*MNH & NCHAN,NH2O,NCO2,NO3,NCNT,NN2O,NCH4,NCO,NC11,NC12,NCFC,NO2
-*MNH real CVCO2,CVN2O,CVCO,CVCH4,CVF11,CVF12,CVO2,FTEMP(JV3),
-*MNH & FCH2O(JV3),FCCO2(JV3),FCO3(JV3),XLIM(JV10),CLIM(JV2)
-*MNH COMMON/YOMRADI/NABS,NATM,NATMS,NSPWV,NTMP1,NTEMP,NCH2O,NCCO2,NCO3,
-*MNH & NCHAN,NH2O,NCO2,NO3,NCNT,NN2O,NCH4,NCO,NC11,NC12,NCFC,NO2
-*MNH COMMON /YOMRADR/CVCO2,CVN2O,CVCO,CVCH4,CVF11,CVF12,CVO2,
-*MNH & FTEMP,FCH2O,FCCO2,FCO3,XLIM,CLIM
- !include 'yomspe.h'
-*MNH integer N_INT,NA
-*MNH real TREF,TPOLY
-*MNH real WNU(JV2),RODWAL(6,8),POLPLCK(6,2),WVNA(JNINT),WVNB(JNINT),
-*MNH & RALPHA,RPI,RAIRM,RH2OM,RCO2M,RO3M,RN2OM,RCOM,RCH4M,RO2M,
-*MNH & RF11M,RF12M
-*MNH COMMON /YOMSPEI/ N_INT,NA,TREF,TPOLY
-*MNH COMMON /YOMSPER/ WNU,RODWAL,POLPLCK,WVNA,WVNB,RALPHA,RPI,
-*MNH & RAIRM,RH2OM,RCO2M,RO3M,RN2OM,RCOM,RCH4M,RO2M,RF11M,RF12M
-C ------------------------------------------------------------------
-C
-C 0.1 ARGUMENTS
-C
- REAL PBSUR(KLON) , PBLEV(KLON,KLEV+1)
- R , PCLDLD(KLON,KLEV) , PCNTRB(KLON,KLEV+1,KLEV+1)
- R , PEM0(KLON), PCLDLU(KLON,KLEV)
- R , PFDC(KLON,KLEV+1), PFUC(KLON,KLEV+1)
-C
- R , PFDT(KLON,KLEV+1), PFUT(KLON,KLEV+1)
-C
-C -------------------------------------------------------------------
-C
-C* 0.2 LOCAL ARRAYS
-C ------------
-C
- REAL ZCLEAR(KLON) , ZCLOUD(KLON)
- S , ZCLM(KLON,KLEV+1,KLEV+1)
- S , ZDNF(KLON,KLEV+1,KLEV+1)
- S , ZFD(KLON) , ZFU(KLON)
- S , ZUPF(KLON,KLEV+1,KLEV+1)
-C
-C ------------------------------------------------------------------
-C
-C* 1. INITIALIZE TO CLEAR-SKY FLUXES
-C ------------------------------
-C
- IMAXC=KLEV
- REPSEC=1.E-12
- REPSEC=1.e-7 ! JPChaboureau's modification to avoid division by zero
-C
- DO JK = 1 , KLEV+1
- DO JL = KIDIA,KFDIA
- PFDT(JL,JK) = PFDC(JL,JK)
- PFUT(JL,JK) = PFUC(JL,JK)
- END DO
- END DO
-C
- DO JK1=1,KLEV+1
- DO JK2=1,KLEV+1
- DO JL = KIDIA,KFDIA
- ZUPF(JL,JK2,JK1)=PFUC(JL,JK1)
- ZDNF(JL,JK2,JK1)=PFDC(JL,JK1)
- END DO
- END DO
- END DO
-C
-C ------------------------------------------------------------------
-C
-C* 2. FLUXES FOR ONE OVERCAST UNITY EMISSIVITY CLOUD
-C ----------------------------------------------
-C
- DO JKC = 1 , IMAXC
- JCLOUD=JKC
- JKCP1=JCLOUD+1
-C
-C* 2.1 ABOVE THE CLOUD
-C ---------------
-C
- DO JK=JKCP1,KLEV+1
- JKM1=JK-1
- DO JL = KIDIA,KFDIA
- ZFU(JL)=0.
- END DO
- IF (JK .GT. JKCP1) THEN
- DO JKJ=JKCP1,JKM1
- DO JL = KIDIA,KFDIA
- ZFU(JL) = ZFU(JL) + PCNTRB(JL,JK,JKJ)
- END DO
- END DO
- END IF
-C
- DO JL = KIDIA,KFDIA
- ZUPF(JL,JKCP1,JK)=PBLEV(JL,JK)-ZFU(JL)
- END DO
- END DO
-C
-C
-C* 2.2 BELOW THE CLOUD
-C ---------------
-C
- DO JK=1,JCLOUD
- JKP1=JK+1
- DO JL = KIDIA,KFDIA
- ZFD(JL)=0.
- END DO
-C
- IF (JK .LT. JCLOUD) THEN
- DO JKJ=JKP1,JCLOUD
- DO JL = KIDIA,KFDIA
- ZFD(JL) = ZFD(JL) + PCNTRB(JL,JK,JKJ)
- END DO
- END DO
- END IF
- DO JL = KIDIA,KFDIA
- ZDNF(JL,JKCP1,JK)=-PBLEV(JL,JK)-ZFD(JL)
- END DO
- END DO
- END DO
-C
-C ------------------------------------------------------------------
-C
-C* 3. CLOUD COVER MATRIX
-C ------------------
-C
-C* ZCLM(JK1,JK2) IS THE OBSCURATION FACTOR BY CLOUD LAYERS BETWEEN
-C HALF-LEVELS JK1 AND JK2 AS SEEN FROM JK1
-C
- DO JK1 = 1 , KLEV+1
- DO JK2 = 1 , KLEV+1
- DO JL = KIDIA,KFDIA
- ZCLM(JL,JK1,JK2) = 0.
- END DO
- END DO
- END DO
-C
-C
-C
-C* 3.1 CLOUD COVER BELOW THE LEVEL OF CALCULATION
-C ------------------------------------------
-C
- DO JK1 = 2 , KLEV+1
- DO JL = KIDIA,KFDIA
- ZCLEAR(JL)=1.
- ZCLOUD(JL)=0.
- END DO
- DO JK = JK1 - 1 , 1 , -1
- DO JL = KIDIA,KFDIA
- IF (KOVLP.EQ.1) THEN
-c* maximum-random
- ZCLEAR(JL)=ZCLEAR(JL)*(1.0-MAX(PCLDLU(JL,JK),ZCLOUD(JL)))
- * /(1.0-MIN(ZCLOUD(JL),1.-REPSEC))
- ZCLM(JL,JK1,JK) = 1.0 - ZCLEAR(JL)
- ZCLOUD(JL) = PCLDLU(JL,JK)
- ELSE IF (KOVLP.EQ.2) THEN
-c* maximum
-c ZCLOUD(JL) = AMAX1(ZCLOUD(JL) , PCLDLU(JL,JK))
- ZCLOUD(JL)=MAX(ZCLOUD(JL),PCLDLU(JL,JK))
- ZCLM(JL,JK1,JK) = ZCLOUD(JL)
- ELSE IF (KOVLP.EQ.3) THEN
-c* random
- ZCLEAR(JL) = ZCLEAR(JL)*(1.0 - PCLDLU(JL,JK))
- ZCLOUD(JL) = 1.0 - ZCLEAR(JL)
- ZCLM(JL,JK1,JK) = ZCLOUD(JL)
- END IF
- END DO
- END DO
- END DO
-C
-C
-C* 3.2 CLOUD COVER ABOVE THE LEVEL OF CALCULATION
-C ------------------------------------------
-C
- DO JK1 = 1 , KLEV
- DO JL = KIDIA,KFDIA
- ZCLEAR(JL)=1.
- ZCLOUD(JL)=0.
- END DO
- DO JK = JK1 , KLEV
- DO JL = KIDIA,KFDIA
- IF (KOVLP.EQ.1) THEN
-c* maximum-random
- ZCLEAR(JL)=ZCLEAR(JL)*(1.0-MAX(PCLDLD(JL,JK),ZCLOUD(JL)))
- * /(1.0-MIN(ZCLOUD(JL),1.-REPSEC))
- ZCLM(JL,JK1,JK) = 1.0 - ZCLEAR(JL)
- ZCLOUD(JL) = PCLDLD(JL,JK)
- ELSE IF (KOVLP.EQ.2) THEN
-c* maximum
-c ZCLOUD(JL) = AMAX1(ZCLOUD(JL) , PCLDLD(JL,JK))
- ZCLOUD(JL)=MAX(ZCLOUD(JL) , PCLDLD(JL,JK))
- ZCLM(JL,JK1,JK) = ZCLOUD(JL)
- ELSE IF (KOVLP.EQ.3) THEN
-c* random
- ZCLEAR(JL) = ZCLEAR(JL)*(1.0 - PCLDLD(JL,JK))
- ZCLOUD(JL) = 1.0 - ZCLEAR(JL)
- ZCLM(JL,JK1,JK) = ZCLOUD(JL)
- END IF
- END DO
- END DO
- END DO
-C
-C
-C ------------------------------------------------------------------
-C
-C* 4. FLUXES FOR PARTIAL/MULTIPLE LAYERED CLOUDINESS
-C ----------------------------------------------
-C
-C* 4.1 DOWNWARD FLUXES
-C ---------------
-C
- DO JL = KIDIA,KFDIA
- PFDT(JL,KLEV+1) = 0.
- END DO
-C
- DO JK1 = KLEV , 1 , -1
-C
-C* CONTRIBUTION FROM CLEAR-SKY FRACTION
-C
- DO JL = KIDIA,KFDIA
- ZFD (JL) = (1. - ZCLM(JL,JK1,KLEV)) * ZDNF(JL,1,JK1)
- END DO
-C
-C* CONTRIBUTION FROM ADJACENT CLOUD
-C
- DO JL = KIDIA,KFDIA
- ZFD(JL) = ZFD(JL) + ZCLM(JL,JK1,JK1) * ZDNF(JL,JK1+1,JK1)
- END DO
-C
-C* CONTRIBUTION FROM OTHER CLOUDY FRACTIONS
-C
- DO JK = KLEV-1 , JK1 , -1
- DO JL = KIDIA,KFDIA
- ZCFRAC = ZCLM(JL,JK1,JK+1) - ZCLM(JL,JK1,JK)
- ZFD(JL) = ZFD(JL) + ZCFRAC * ZDNF(JL,JK+2,JK1)
- END DO
- END DO
-C
- DO JL = KIDIA,KFDIA
- PFDT(JL,JK1) = ZFD (JL)
- END DO
-C
- END DO
-C
-C
-C
-C
-C* 4.2 UPWARD FLUX AT THE SURFACE
-C --------------------------
-C
- DO JL = KIDIA,KFDIA
- PFUT(JL,1) = PEM0(JL)*PBSUR(JL)-(1.-PEM0(JL))*PFDT(JL,1)
- END DO
-C
-C
-C
-C
-C* 4.3 UPWARD FLUXES
-C -------------
-C
- DO JK1 = 2 , KLEV+1
-C
-C* CONTRIBUTION FROM CLEAR-SKY FRACTION
-C
- DO JL = KIDIA,KFDIA
- ZFU (JL) = (1. - ZCLM(JL,JK1,1)) * ZUPF(JL,1,JK1)
- END DO
-C
-C* CONTRIBUTION FROM ADJACENT CLOUD
-C
- DO JL = KIDIA,KFDIA
- ZFU(JL) = ZFU(JL) + ZCLM(JL,JK1,JK1-1) * ZUPF(JL,JK1,JK1)
- END DO
-C
-C* CONTRIBUTION FROM OTHER CLOUDY FRACTIONS
-C
- DO JK = 2 , JK1-1
- DO JL = KIDIA,KFDIA
- ZCFRAC = ZCLM(JL,JK1,JK-1) - ZCLM(JL,JK1,JK)
- ZFU(JL) = ZFU(JL) + ZCFRAC * ZUPF(JL,JK ,JK1)
- END DO
- END DO
-C
- DO JL = KIDIA,KFDIA
- PFUT(JL,JK1) = ZFU (JL)
- END DO
-C
- END DO
-C
-C-----------------------------------------------------------------------
-C
- RETURN
- END
diff --git a/src/MNH/reset_exseg.f90 b/src/MNH/reset_exseg.f90
index b467f7c05..ce172c04b 100644
--- a/src/MNH/reset_exseg.f90
+++ b/src/MNH/reset_exseg.f90
@@ -173,9 +173,6 @@ IF ( NRAD_3D>=1 ) THEN
CGETRAD='INIT'
END IF
!
-IF(LEN_TRIM(CRAD_SAT) /= 0) THEN
- CRAD='ECMW'
-END IF
!
IF ( IP == 1 ) PRINT*,'RESET_EXSEG OUTPUT: NRAD_3D =',NRAD_3D,' CRAD =',CRAD,' CGETRAD =',CGETRAD
!
diff --git a/src/MNH/write_lfifm1_for_diag_supp.f90 b/src/MNH/write_lfifm1_for_diag_supp.f90
index 974e78231..b6c5bf1ba 100644
--- a/src/MNH/write_lfifm1_for_diag_supp.f90
+++ b/src/MNH/write_lfifm1_for_diag_supp.f90
@@ -71,7 +71,7 @@ END MODULE MODI_WRITE_LFIFM1_FOR_DIAG_SUPP
!! choose the platform, the satellite, the sensor for all channels
!! (see the table in rttov science and validation report) and the
!! type of calculations in the namelist: 0 = tb, 1 = tb + jacobian,
-!! 2 = tb + adjoint, 3 = tb + jacobian + adjoint)
+!! 2 = tb + adjoint, 3 = tb + jacobian + adjoint) --- !!! removed !!!
!! V. Masson 01/2004 removes surface (externalization)
!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
!! change of YCOMMENT
@@ -82,7 +82,7 @@ END MODULE MODI_WRITE_LFIFM1_FOR_DIAG_SUPP
!! P.Tulet : Diag for salt and orilam
!! J.-P. Chaboureau 07/03/2016 fix the dimensions of local arrays
!! P.Wautelet : 11/07/2016 : removed MNH_NCWRIT define
-!! J.-P. Chaboureau 31/10/2016 add the call to RTTOV11
+!! J.-P. Chaboureau 31/10/2016 add the call to RTTOV11 --- !!! removed !!!
!! F. Brosse 10/2016 add chemical production destruction terms outputs
!! M.Leriche 01/07/2017 Add DIAG chimical surface fluxes
!! J.-P. Chaboureau 01/2018 add altitude interpolation
@@ -117,7 +117,7 @@ USE MODD_CONF, ONLY: LCARTESIAN
USE MODD_CONF_n, ONLY: LUSERC, LUSERI, LUSERV, NRR
USE MODD_DEEP_CONVECTION_n, ONLY: NCLBASCONV, NCLTOPCONV, XCAPE, XDMFCONV, XDRCCONV, XDRICONV, XDRVCONV, &
XDTHCONV, XDSVCONV, XMFCONV, XPRLFLXCONV, XPRSFLXCONV, XUMFCONV
-USE MODD_DIAG_FLAG, ONLY: CRAD_SAT, LCHEMDIAG, LCLD_COV, LCOARSE, LISOAL, LISOPR, LISOTH, LRAD_SUBG_COND, &
+USE MODD_DIAG_FLAG, ONLY: LCHEMDIAG, LCLD_COV, LCOARSE, LISOAL, LISOPR, LISOTH, LRAD_SUBG_COND, &
NCONV_KF, NDXCOARSE, NRAD_3D, NRTTOVINFO, XISOAL, XISOPR, XISOTH
USE MODD_FIELD_n, ONLY: XCLDFR, XICEFR, XPABST, XSIGS, XTHT, XTKET, XRT, XUT, XVT, XWT
USE MODD_GRID_n, ONLY: XZHAT, XZZ
@@ -143,12 +143,6 @@ USE MODE_NEIGHBORAVG, ONLY: BLOCKAVG, MOVINGAVG
USE MODE_THERMO, ONLY: SM_FOES
USE MODE_TOOLS_LL, ONLY: GET_INDICE_ll
-#ifdef MNH_RTTOV_8
-USE MODI_CALL_RTTOV8
-#endif
-#ifdef MNH_RTTOV_11
-USE MODI_CALL_RTTOV11
-#endif
#ifdef MNH_RTTOV_13
USE MODI_CALL_RTTOV13
#endif
@@ -710,97 +704,12 @@ IF (LCHEMDIAG) THEN
END IF
!-------------------------------------------------------------------------------
!
-!* Brightness temperatures from the radiatif transfer code (Morcrette, 1991)
-!
-IF (LEN_TRIM(CRAD_SAT) /= 0 .AND. NRR /=0) THEN
- ALLOCATE (ZIRBT(IIU,IJU),ZWVBT(IIU,IJU))
- ITOTGEO=0
- IF (INDEX(CRAD_SAT,'GOES-E') /= 0) THEN
- ITOTGEO= ITOTGEO+1
- INDGEO(ITOTGEO) = 1
- YNAM_SAT(ITOTGEO) = 'GOES-E'
- END IF
- IF (INDEX(CRAD_SAT,'GOES-W') /= 0) THEN
- ITOTGEO= ITOTGEO+1
- INDGEO(ITOTGEO) = 2
- YNAM_SAT(ITOTGEO) = 'GOES-W'
- END IF
- IF (INDEX(CRAD_SAT,'GMS') /= 0) THEN
- ITOTGEO= ITOTGEO+1
- INDGEO(ITOTGEO) = 3
- YNAM_SAT(ITOTGEO) = 'GMS'
- END IF
- IF (INDEX(CRAD_SAT,'INDSAT') /= 0) THEN
- ITOTGEO= ITOTGEO+1
- INDGEO(ITOTGEO) = 4
- YNAM_SAT(ITOTGEO) = 'INDSAT'
- END IF
- IF (INDEX(CRAD_SAT,'METEOSAT') /= 0) THEN
- ITOTGEO= ITOTGEO+1
- INDGEO(ITOTGEO) = 5
- YNAM_SAT(ITOTGEO) = 'METEOSAT'
- END IF
- PRINT*,'YOU ASK FOR BRIGHTNESS TEMPERATURES FOR ',ITOTGEO,' SATELLITE(S)'
- IF (NRR==1) THEN
- PRINT*,' THERE IS ONLY VAPOR WATER IN YOUR ATMOSPHERE'
- PRINT*,' IRBT WILL NOT TAKE INTO ACCOUNT CLOUDS.'
- END IF
- !
- DO JI=1,ITOTGEO
- ZIRBT(:,:) = XUNDEF
- ZWVBT(:,:) = XUNDEF
- CALL RADTR_SATEL( TDTCUR%nyear, TDTCUR%nmonth, TDTCUR%nday, TDTCUR%xtime, &
- NDLON, NFLEV, NSTATM, NRAD_COLNBR, XEMIS(:,:,1), &
- XCCO2, XTSRAD, XSTATM, XTHT, XRT, XPABST, XZZ, &
- XSIGS, XMFCONV, MAX(XCLDFR,XICEFR), LUSERI, LSIGMAS, &
- LSUBG_COND, LRAD_SUBG_COND, ZIRBT, ZWVBT, &
- INDGEO(JI), VSIGQSAT )
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = TRIM(YNAM_SAT(JI))//'_IRBT', &
- CSTDNAME = '', &
- CLONGNAME = TRIM(YNAM_SAT(JI))//'_IRBT', &
- CUNITS = 'K', &
- CDIR = 'XY', &
- CCOMMENT = TRIM(YNAM_SAT(JI))//' Infra-Red Brightness Temperature', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZIRBT)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = TRIM(YNAM_SAT(JI))//'_WVBT', &
- CSTDNAME = '', &
- CLONGNAME = TRIM(YNAM_SAT(JI))//'_WVBT', &
- CUNITS = 'K', &
- CDIR = 'XY', &
- CCOMMENT = TRIM(YNAM_SAT(JI))//' Water-Vapor Brightness Temperature', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWVBT)
- END DO
- DEALLOCATE(ZIRBT,ZWVBT)
-END IF
-!
-!-------------------------------------------------------------------------------
-!
!* Brightness temperatures from the Radiatif Transfer for Tiros Operational
! Vertical Sounder (RTTOV) code
!
IF (NRTTOVINFO(1,1) /= NUNDEF) THEN
! PRINT*,'YOU ASK FOR BRIGHTNESS TEMPERATURE COMPUTED BY THE RTTOV CODE'
-#if defined(MNH_RTTOV_8)
- CALL CALL_RTTOV8(NDLON, NFLEV, NSTATM, XEMIS(:,:,1), XTSRAD, XSTATM, XTHT, XRT, &
- XPABST, XZZ, XMFCONV, MAX(XCLDFR,XICEFR), XUT(:,:,IKB), XVT(:,:,IKB), &
- LUSERI, NRTTOVINFO, TPFILE )
-#elif defined(MNH_RTTOV_11)
- CALL CALL_RTTOV11(NDLON, NFLEV, XEMIS(:,:,1), XTSRAD, XTHT, XRT, &
- XPABST, XZZ, XMFCONV, MAX(XCLDFR,XICEFR), XUT(:,:,IKB), XVT(:,:,IKB), &
- LUSERI, NRTTOVINFO, TPFILE )
-#elif defined(MNH_RTTOV_13)
+#if defined(MNH_RTTOV_13)
CALL CALL_RTTOV13(NDLON, NFLEV, XEMIS(:,:,1), XTSRAD, XTHT, XRT, &
XPABST, XZZ, XMFCONV, MAX(XCLDFR,XICEFR), XUT(:,:,IKB), XVT(:,:,IKB), &
LUSERI, NRTTOVINFO, TPFILE )
diff --git a/src/Makefile.MESONH.mk b/src/Makefile.MESONH.mk
index 791ff37ea..2444943ff 100644
--- a/src/Makefile.MESONH.mk
+++ b/src/Makefile.MESONH.mk
@@ -200,30 +200,7 @@ endif
##########################################################
ifdef MNH_RTTOV
ifndef VER_RTTOV
-VER_RTTOV = 8.7
-endif
-ifeq "$(VER_RTTOV)" "8.7"
-DIR_RTTOV += LIB/RTTOV/src
-CPPFLAGS_RTTOV = -DMNH_RTTOV
-INC_RTTOV = -I$(B)LIB/RTTOV/src
-#
-DIR_MASTER += $(DIR_RTTOV)
-CPPFLAGS += $(CPPFLAGS_RTTOV)
-INC += $(INC_RTTOV)
-CPPFLAGS += $(CPPFLAGS_RTTOV)
-CPPFLAGS_MNH += -DMNH_RTTOV_8=MNH_RTTOV_8
-endif
-ifeq "$(VER_RTTOV)" "11.3"
-DIR_RTTOV=${SRC_MESONH}/src/LIB/RTTOV-${VER_RTTOV}
-RTTOV_PATH=${DIR_RTTOV}
-#
-INC_RTTOV ?= -I${RTTOV_PATH}/include -I${RTTOV_PATH}/mod
-LIB_RTTOV ?= -L${RTTOV_PATH}/lib -lrttov11_coef_io -lrttov11_mw_scatt -lrttov11_main
-INC += $(INC_RTTOV)
-LIBS += $(LIB_RTTOV)
-VPATH += $(RTTOV_PATH)/mod
-CPPFLAGS += $(CPPFLAGS_RTTOV)
-CPPFLAGS_MNH += -DMNH_RTTOV_11=MNH_RTTOV_11
+VER_RTTOV = 13.2
endif
ifeq "$(VER_RTTOV)" "13.2"
DIR_RTTOV=${SRC_MESONH}/src/LIB/RTTOV-${VER_RTTOV}
diff --git a/src/PHYEX/micro/radtr_satel.f90 b/src/PHYEX/micro/radtr_satel.f90
deleted file mode 100644
index 5f29acd95..000000000
--- a/src/PHYEX/micro/radtr_satel.f90
+++ /dev/null
@@ -1,756 +0,0 @@
-!MNH_LIC Copyright 2000-2021 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! #######################
- MODULE MODI_RADTR_SATEL
-! #######################
-IMPLICIT NONE
-INTERFACE
-!
- SUBROUTINE RADTR_SATEL(KYEARF, KMONTHF, KDAYF, PSECF, &
- KDLON, KFLEV, KSTATM, KRAD_COLNBR, PEMIS, PCCO2, &
- PTSRAD, PSTATM, PTHT, PRT, PPABST, PZZ, &
- PSIGS, PMFCONV, PCLDFR, OUSERI, OSIGMAS, &
- OSUBG_COND, ORAD_SUBG_COND, PIRBT, PWVBT, KGEO,PSIGQSAT )
-IMPLICIT NONE
-!
-INTEGER, INTENT(IN) :: KYEARF ! year of Final date
-INTEGER, INTENT(IN) :: KMONTHF ! month of Final date
-INTEGER, INTENT(IN) :: KDAYF ! day of Final date
-REAL, INTENT(IN) :: PSECF ! number of seconds since date at 00 UTC
-!
-INTEGER, INTENT(IN) :: KDLON !number of columns where the
- !radiation calculations are performed
-INTEGER, INTENT(IN) :: KFLEV !number of vertical levels where the
- !radiation calculations are performed
-INTEGER, INTENT(IN) :: KSTATM !index of the standard atmosphere level
- !just above the model top
-INTEGER, INTENT(IN) :: KRAD_COLNBR !factor by which the memory is split
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PEMIS !Surface IR EMISsivity
-REAL, INTENT(IN) :: PCCO2 !CO2 content
-REAL, DIMENSION(:,:), INTENT(IN) :: PTSRAD !RADiative Surface Temperature
-REAL, DIMENSION(:,:), INTENT(IN) :: PSTATM !selected standard atmosphere
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT !THeta at t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT !moist variables at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST !pressure at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ !Model level heights
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s from turbulence scheme
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV! convective mass flux (kg /s m^2)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! cloud fraction
-!
-LOGICAL, INTENT(IN) :: OUSERI ! logical switch to compute both
- ! liquid and solid condensate (OUSERI=.TRUE.)
- ! or only liquid condensate (OUSERI=.FALSE.)
-LOGICAL, INTENT(IN) :: OSIGMAS! use present global Sigma_s values
- ! or that from turbulence scheme
-LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid Condensation
- ! (prognotic mode)
-LOGICAL, INTENT(IN) :: ORAD_SUBG_COND ! Switch for Subgrid Condensation
- ! (diagnostic mode)
-!
-REAL, DIMENSION(:,:), INTENT(OUT):: PIRBT !IR Brightness Temp. (K)
-REAL, DIMENSION(:,:), INTENT(OUT):: PWVBT !WV Brightness Temp. (K)
-!
-INTEGER, INTENT(IN) :: KGEO !SATELLITE INDEX
-REAL, INTENT(IN) :: PSIGQSAT ! use an extra "qsat" variance contribution (OSIGMAS case)
-!
-END SUBROUTINE RADTR_SATEL
-END INTERFACE
-END MODULE MODI_RADTR_SATEL
-! #####################################################################
- SUBROUTINE RADTR_SATEL(KYEARF, KMONTHF, KDAYF, PSECF, &
- KDLON, KFLEV, KSTATM, KRAD_COLNBR, PEMIS, PCCO2, &
- PTSRAD, PSTATM, PTHT, PRT, PPABST, PZZ, &
- PSIGS, PMFCONV, PCLDFR, OUSERI, OSIGMAS, &
- OSUBG_COND, ORAD_SUBG_COND, PIRBT, PWVBT, KGEO,PSIGQSAT)
-! #####################################################################
-!
-!!**** *RADTR_SATEL* -
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!! Chaboureau, J.-P., J.-P. Cammas, P. Mascart, J.-P. Pinty, C. Claud, R. Roca,
-!! and J.-J. Morcrette, 2000: Evaluation of a cloud system life-cycle simulated
-!! by Meso-NH during FASTEX using METEOSAT radiances and TOVS-3I cloud retrievals.
-!! Q. J. R. Meteorol. Soc., 126, 1735-1750.
-!! Chaboureau, J.-P. and P. Bechtold, 2002: A simple cloud parameterization from
-!! cloud resolving model data: Theory and application. J. Atmos. Sci., 59, 2362-2372.
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Chaboureau *L.A.*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 29/03/00
-!! J.-P. Chaboureau 15/04/03 add call to the subgrid condensation scheme
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! G.Delautier 04/2016 : BUG JPHEXT
-!! S. Riette 11/2016 : Condensation interface changed
-! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST
-USE MODD_PARAMETERS
-USE MODD_GRID_n
-USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAMN
-USE MODD_NEB_n, ONLY: NEBN
-USE MODD_TURB_n, ONLY: TURBN
-USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
-!
-USE MODD_RAD_TRANSF
-USE MODE_ll
-USE MODE_FILL_DIMPHYEX, ONLY: FILL_DIMPHYEX
-!
-USE MODI_INIT_NBMOD
-USE MODI_DETER_ANGLE
-USE MODI_MAKE_RADSAT
-!
-USE MODI_CONDENSATION
-!
-IMPLICIT NONE
-!
-!* 0.1 DECLARATIONS OF DUMMY ARGUMENTS :
-!
-INTEGER, INTENT(IN) :: KYEARF ! year of Final date
-INTEGER, INTENT(IN) :: KMONTHF ! month of Final date
-INTEGER, INTENT(IN) :: KDAYF ! day of Final date
-REAL, INTENT(IN) :: PSECF ! number of seconds since date at 00 UTC
-!
-INTEGER, INTENT(IN) :: KDLON !number of columns where the
- ! radiation calculations are performed
-INTEGER, INTENT(IN) :: KFLEV !number of vertical levels where the
- ! radiation calculations are performed
-INTEGER, INTENT(IN) :: KSTATM !index of the standard atmosphere level
- !just above the model top
-INTEGER, INTENT(IN) :: KRAD_COLNBR !factor by which the memory is split
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PEMIS !Surface IR EMISsivity
-REAL, INTENT(IN) :: PCCO2 !CO2 content
-REAL, DIMENSION(:,:), INTENT(IN) :: PTSRAD !RADiative Surface Temperature
-REAL, DIMENSION(:,:), INTENT(IN) :: PSTATM !selected standard atmosphere
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT !THeta at t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT !moist variables at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST !pressure at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ !Model level heights
-!
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s from turbulence scheme
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV! convective mass flux (kg /s m^2)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! cloud fraction
-!
-LOGICAL, INTENT(IN) :: OUSERI ! logical switch to compute both
- ! liquid and solid condensate (OUSERI=.TRUE.)
- ! or only liquid condensate (OUSERI=.FALSE.)
-LOGICAL, INTENT(IN) :: OSIGMAS! use present global Sigma_s values
- ! or that from turbulence scheme
-LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid Condensation
- ! (prognotic mode)
-LOGICAL, INTENT(IN) :: ORAD_SUBG_COND ! Switch for Subgrid Condensation
- ! (diagnostic mode)
-!
-REAL, DIMENSION(:,:), INTENT(OUT):: PIRBT !IR Brightness Temp. (K)
-REAL, DIMENSION(:,:), INTENT(OUT):: PWVBT !WV Brightness Temp. (K)
-!
-INTEGER, INTENT(IN) :: KGEO !SATELLITE INDEX
-REAL, INTENT(IN) :: PSIGQSAT ! use an extra "qsat" variance contribution (OSIGMAS case)
-!
-!* 0.2 DECLARATIONS OF LOCAL VARIABLES
-!
-LOGICAL :: GPTDEP, GPVOIGT
-!
-! reference state
-!from inprof
-INTEGER :: IGL, ICABS, ING1, IUABS, IINIS, IENDS, ICONF, ICLOUD, IOVLP
-INTEGER :: IH2O, ICO2, IO3, ICNT, IN2O, ICH4, ICO, IC11, IC12, ICFC
-!
-LOGICAL, DIMENSION(KDLON) :: GDOIT_2D ! .TRUE. for the larger scale
-LOGICAL, DIMENSION(KDLON,KFLEV) :: GDOIT ! .TRUE. for all the levels of the
- ! larger scale columns
-!
-INTEGER :: JI,JJ,JK,JK1,JK2,JKRAD ! loop indexes
-!
-INTEGER :: IIB,IIE ! I index value of the first/last inner mass point
-INTEGER :: IJB,IJE ! J index value of the first/last inner mass point
-INTEGER :: IKB,IKE ! K index value of the first/last inner mass point
-INTEGER :: IIU ! array size for the first index
-INTEGER :: IJU ! array size for the second index
-INTEGER :: IKU ! array size for the third index
-INTEGER :: IIJ ! reformatted array index
-INTEGER :: IKSTAE ! level number of the STAndard atmosphere array
-INTEGER :: IKUP ! vertical level above which STAndard atmosphere data
-INTEGER :: IDOIT_COL ! number of larger scale columns
-INTEGER :: IDOIT ! number of levels corresponding of the larger scale
- ! columns are filled in
-INTEGER :: IDIM ! effective number of columns for which the radiation
- ! code is run
-INTEGER, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,3)) :: IKKOZ ! indice array used to
- ! vertically interpolate the ozone content on the model grid
-!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZTAVE ! mean-layer temperature
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZQVAVE ! mean-layer specific humidity
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZO3AVE ! mean-layer ozone content
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZPRES_HL ! half-level pressure
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZT_HL ! half-level temperature
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZCLDLD ! Downward cloud emissivity
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZCLDLU ! Upward cloud emissivity
-REAL, DIMENSION(:), ALLOCATABLE :: ZVIEW ! cosecant of viewing angle
-REAL, DIMENSION(:), ALLOCATABLE :: ZREMIS ! Reformatted PEMIS array
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEXNT ! Exner function
-REAL, DIMENSION(SIZE(PSTATM,1)) :: ZSTAZZ,ZSTAOZ ! STAndard atmosphere height
- ! and OZone content
-REAL :: ZOZ ! variable used to interpolate the ozone profile
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZDT0 ! surface discontinuity
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZRADBT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZRADBC
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZRADFT
-REAL, DIMENSION(:), ALLOCATABLE :: ZULAT
-REAL, DIMENSION(:), ALLOCATABLE :: ZULON
-!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZZRADFT
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZWORK1, ZWORK3
-!
-! split arrays used to split the memory required by the ECMWF_radiation
-! subroutine, the fields have the same meaning as their complete counterpart
-REAL, DIMENSION(:), ALLOCATABLE :: ZREMIS_SPLIT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZO3AVE_SPLIT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZT_HL_SPLIT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZPRES_HL_SPLIT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZQVAVE_SPLIT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZTAVE_SPLIT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZCLDLD_SPLIT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZCLDLU_SPLIT
-REAL, DIMENSION(:), ALLOCATABLE :: ZVIEW_SPLIT
-REAL, DIMENSION(:), ALLOCATABLE :: ZDT0_SPLIT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZRADBT_SPLIT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZRADBC_SPLIT
-!
-INTEGER :: JI_SPLIT ! loop on the split array
-INTEGER :: INUM_CALL ! number of CALL of the radiation scheme
-INTEGER :: IDIM_EFF ! effective number of air-columns to compute
-INTEGER :: IDIM_RESIDUE ! number of remaining air-columns to compute
-INTEGER :: IBEG, IEND ! auxiliary indices
-!
-! Other arrays for emissivity
-REAL :: ZFLWP, ZFIWP, ZANGCOR, ZRADLP, ZMULTS, ZTMP, ZKI
-!
-! Other arrays for condensation
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTEMP ! Temperature
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSIGRC ! s r_c / sig_s^2
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZNCLD ! grid scale cloud fraction
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRC_IN, ZRC_OUT ! grid scale r_c mixing ratio (kg/kg)
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRI_IN, ZRI_OUT ! grid scale r_i (kg/kg)
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRV_IN, ZRV_OUT ! grid scale r_v (kg/kg)
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRHO
-REAL, DIMENSION(SIZE(PPABST,1),SIZE(PPABST,2)) :: ZSIGQSAT2D, ZDUM
-TYPE(DIMPHYEX_t) :: D
-!----------------------------------------------------------------------------
-!
-!* 1. INITIALIZATION OF CONSTANTS FOR TRANSFERT CODE
-! ----------------------------------------------
-!
-CALL INIT_NBMOD(KFLEV, IGL, ICABS, ING1, IUABS, IINIS, IENDS, &
- IH2O, ICO2, IO3, ICNT, IN2O, ICH4, ICO, IC11, IC12, ICFC, &
- ICONF, ICLOUD, IOVLP, GPVOIGT, GPTDEP)
-X1CO2 = PCCO2 / 44.0 * XMD
-!
-!----------------------------------------------------------------------------
-!
-!* 2. COMPUTE DIMENSIONS OF ARRAYS AND OTHER INDICES
-! ----------------------------------------------
-!
-IIU = SIZE(PTHT,1)
-IJU = SIZE(PTHT,2)
-IKU = SIZE(PTHT,3)
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-IKB = 1 + JPVEXT
-IKE = IKU - JPVEXT
-CALL FILL_DIMPHYEX(D, IIU, IJU, IKU)
-!
-IKSTAE = SIZE(PSTATM,1)
-IKUP = IKE-JPVEXT+1
-!
-!----------------------------------------------------------------------------
-!
-!* 3. INITIALIZES THE MEAN-LAYER VARIABLES
-! ------------------------------------
-!
-ALLOCATE(ZEXNT(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
-ZEXNT(:,:,:)= ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
-!
-ALLOCATE(ZTAVE(KDLON,KFLEV))
-ALLOCATE(ZQVAVE(KDLON,KFLEV))
-!
-ZQVAVE(:,:) = 0.0
-!
-DO JK=IKB,IKE
- JKRAD = JK-JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZTAVE(IIJ,JKRAD) = PTHT(JI,JJ,JK)*ZEXNT(JI,JJ,JK)
- END DO
- END DO
-END DO
-!
-! Check if the humidity mixing ratio is available
-!
-IF( SIZE(PRT(:,:,:,:),4) >= 1 ) THEN
- DO JK=IKB,IKE
- JKRAD = JK-JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZQVAVE(IIJ,JKRAD) = PRT(JI,JJ,JK,1)
- END DO
- END DO
- END DO
-END IF
-!
-! Standard atmosphere extension
-!
-DO JK=IKUP,KFLEV
- JK1 = (KSTATM-1)+(JK-IKUP)
- JK2 = JK1+1
- ZTAVE(:,JK) = 0.5*( PSTATM(JK1,3)+PSTATM(JK2,3) )
- ZQVAVE(:,JK) = 0.5*( PSTATM(JK1,5)/PSTATM(JK1,4)+ &
- PSTATM(JK2,5)/PSTATM(JK2,4) )
-END DO
-!
-!----------------------------------------------------------------------------
-!
-!* 4. INITIALIZES THE HALF-LEVEL VARIABLES
-! ------------------------------------
-!
-ALLOCATE(ZPRES_HL(KDLON,KFLEV+1))
-ALLOCATE(ZT_HL(KDLON,KFLEV+1))
-!
-DO JK=IKB,IKE+1
- JKRAD = JK-JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZPRES_HL(IIJ,JKRAD) = XP00 * &
- (0.5*(ZEXNT(JI,JJ,JK)+ZEXNT(JI,JJ,JK-1)))**(XCPD/XRD)
- END DO
- END DO
-END DO
-!
-! Standard atmosphere extension
-! begining at ikup+1 level allows to use a model domain higher than 50km
-!
-DO JK=IKUP+1,KFLEV+1
- JK1 = (KSTATM-1)+(JK-IKUP)
- ZPRES_HL(:,JK) = PSTATM(JK1,2)*100.0
-END DO
-!
-! Surface temperature at the first level
-DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZT_HL(IIJ,1) = PTSRAD(JI,JJ)
- END DO
-END DO
-!
-! Temperature at half levels
-ZT_HL(:,2:IKE-JPVEXT) = 0.5*(ZTAVE(:,1:IKE-JPVEXT-1)+ZTAVE(:,2:IKE-JPVEXT))
-!
-DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZT_HL(IIJ,IKE-JPVEXT+1) = 0.5*PTHT(JI,JJ,IKE )*ZEXNT(JI,JJ,IKE ) &
- + 0.5*PTHT(JI,JJ,IKE+1)*ZEXNT(JI,JJ,IKE+1)
- END DO
-END DO
-!
-! Standard atmosphere extension
-! begining at ikup+1 level allows to use a model domain higher than 50km
-!
-DO JK=IKUP+1,KFLEV+1
- JK1 = (KSTATM-1)+(JK-IKUP)
- ZT_HL(:,JK) = PSTATM(JK1,3)
-END DO
-!
-!----------------------------------------------------------------------------
-!
-!* 5. INITIALIZES THE OZONE PROFILES from the standard atmosphere
-! ------------------------------
-!
-ALLOCATE(ZO3AVE(KDLON,KFLEV))
-!
-ZSTAOZ(:) = PSTATM(:,6)/PSTATM(:,4)
-ZSTAZZ(:) = 1000.0*PSTATM(:,1)
-!
-DO JJ = IJB,IJE
- DO JK2 = IKB,IKE
- JKRAD = JK2-JPVEXT
- IKKOZ(:,JK2) = IKB-1
- DO JK1 = 1,IKSTAE
- DO JI = IIB,IIE
- IKKOZ(JI,JK2)=IKKOZ(JI,JK2) + NINT(0.5 + SIGN(0.5, &
- -ZSTAZZ(JK1)+0.5*(PZZ(JI,JJ,JK2)+PZZ(JI,JJ,JK2+1)) ))
- END DO
- END DO
- DO JI = IIB,IIE
- ZOZ=(0.5*(PZZ(JI,JJ,JK2)+PZZ(JI,JJ,JK2+1))- ZSTAZZ(IKKOZ(JI,JK2))) &
- /( ZSTAZZ(IKKOZ(JI,JK2)+1) - ZSTAZZ(IKKOZ(JI,JK2)))
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZO3AVE(IIJ,JKRAD) =( (1.- ZOZ) * ZSTAOZ(IKKOZ(JI,JK2)) &
- + ZOZ * ZSTAOZ(IKKOZ(JI,JK2)+1))
- END DO
- END DO
-END DO
-!
-DO JK=IKUP,KFLEV
- JK1 = (KSTATM)+(JK-IKUP)
- ZO3AVE(:,JK) = ZSTAOZ(JK1)
-END DO
-!
-!----------------------------------------------------------------------------
-!
-!* 6. CALLS THE E.C.M.W.F. RADIATION CODE
-! -----------------------------------
-!
-!* 6.1 INITIALIZES 2D AND SURFACE FIELDS
-!
-ALLOCATE(ZREMIS(KDLON))
-DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZREMIS(IIJ) = PEMIS(JI,JJ)
- END DO
-END DO
-!
-! initializes surface discontinuity field
-ALLOCATE(ZDT0(KDLON))
-DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZDT0(IIJ) = PTSRAD(JI,JJ) - PTHT(JI,JJ,1)*ZEXNT(JI,JJ,1)
- END DO
-END DO
-!
-ALLOCATE(ZULAT(KDLON))
-ALLOCATE(ZULON(KDLON))
-DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZULON(IIJ) = XLON(JI,JJ)
- ZULAT(IIJ) = XLAT(JI,JJ)
- END DO
-END DO
-ALLOCATE(ZVIEW(KDLON))
-CALL DETER_ANGLE(KGEO, KDLON, ZULAT, ZULON, ZVIEW)
-DEALLOCATE(ZULAT)
-DEALLOCATE(ZULON)
-!
-!
-ALLOCATE(ZCLDLD(KDLON,KFLEV))
-ALLOCATE(ZCLDLU(KDLON,KFLEV))
-ZCLDLD = 0.
-ZCLDLU = 0.
-!
-IF( SIZE(PRT(:,:,:,:),4) >= 2 ) THEN
- ALLOCATE(ZNCLD(IIU,IJU,IKU))
- ALLOCATE(ZRC_IN(IIU,IJU,IKU))
- ALLOCATE(ZRC_OUT(IIU,IJU,IKU))
- ZRC_IN=PRT(:,:,:,2)
- ALLOCATE(ZRI_IN(IIU,IJU,IKU))
- ALLOCATE(ZRI_OUT(IIU,IJU,IKU))
- ZRI_IN=0.
- IF( OUSERI ) ZRI_IN=PRT(:,:,:,4)
- IF ( .NOT. OSUBG_COND .AND. ORAD_SUBG_COND) THEN
- PRINT*,' THE SUBGRID CONDENSATION SCHEME IN DIAGNOSTIC MODE IS ACTIVATED'
- ALLOCATE(ZTEMP(IIU,IJU,IKU))
- ZTEMP=PTHT*ZEXNT
- ALLOCATE(ZSIGRC(IIU,IJU,IKU))
- ALLOCATE(ZRV_IN(IIU,IJU,IKU))
-
- ZRV_IN=PRT(:,:,:,1)
- ALLOCATE(ZRHO(IIU,IJU,IKU))
- ZRHO=1. !unused
- ZSIGQSAT2D(:,:)=PSIGQSAT
- !CALL CONDENSATION( IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, 1, &
- ! 'T', 'CB02', 'CB',&
- ! PPABST, PZZ, ZRHO, ZTEMP, ZRV_IN, ZRV_OUT, ZRC_IN, ZRC_OUT, ZRI_IN, ZRI_OUT, &
- ! PRT(:,:,:,2), PRT(:,:,:,5), PRT(:,:,:,6), PSIGS, PMFCONV, ZNCLD, &
- ! ZSIGRC, OUSERI, OSIGMAS, .FALSE., .FALSE., &
- ! ZDUM, ZDUM, ZDUM, ZDUM, ZDUM, ZSIGQSAT2D )
- CALL CONDENSATION(D, CST, RAIN_ICE_PARAMN, NEBN, TURBN, &
- &'T', 'CB02', 'CB', &
- &PPABST, PZZ, ZRHO, ZTEMP, ZRV_IN, ZRV_OUT, ZRC_IN, ZRC_OUT, ZRI_IN, ZRI_OUT, &
- &PRT(:,:,:,2), PRT(:,:,:,5), PRT(:,:,:,6), PSIGS, .FALSE., PMFCONV, ZNCLD, ZSIGRC, .FALSE., &
- &OSIGMAS, .FALSE., &
- &ZDUM, ZDUM, ZDUM, ZDUM, ZDUM, ZSIGQSAT2D)
- DEALLOCATE(ZTEMP,ZSIGRC)
- DEALLOCATE(ZRV_OUT)
- ELSE
- ZNCLD=PCLDFR
- END IF
- DO JK=IKB,IKE-1
- JKRAD = JK-JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- IF ( ZVIEW(IIJ) /= XUNDEF .AND. &
- (ZRC_OUT(JI,JJ,JK) > 0. .OR. ZRI_OUT(JI,JJ,JK) > 0. ) ) THEN
- ZFLWP = ZRC_OUT(JI,JJ,JK) / XG /MAX(1.E-10,ZNCLD(JI,JJ,JK)) &
- * (PPABST(JI,JJ,JK)-PPABST(JI,JJ,JK+1))
- ZFIWP = ZRI_OUT(JI,JJ,JK) / XG /MAX(1.E-10,ZNCLD(JI,JJ,JK)) &
- * (PPABST(JI,JJ,JK)-PPABST(JI,JJ,JK+1))
- ZANGCOR = ZVIEW(IIJ) / 1.66
- !!!Parametrization following Ou and Chou, 1995 (Atmos. Res.)
- ZTMP = ZTAVE(IIJ,JKRAD)-XTT !ZTMP in Celsius degree
- ZRADLP = 326.3+12.42*ZTMP+0.197*(ZTMP**2)+0.0012*(ZTMP**3)
- ZRADLP = MIN(140., MAX(20., ZRADLP))
-!!! Parametrization following Ebert and Curry, 1992 (JGR-d)
- ZKI = 0.3 + 1290. / ZRADLP
- ZCLDLD(IIJ,JKRAD) = ZNCLD(JI,JJ,JK)*(1.-EXP &
- ( -158.*ZFLWP *ZANGCOR-ZKI*ZFIWP*ZVIEW(IIJ)))
- ZCLDLU(IIJ,JKRAD) = ZNCLD(JI,JJ,JK)*(1.-EXP &
- ( -130.*ZFLWP *ZANGCOR-ZKI*ZFIWP*ZVIEW(IIJ)))
- END IF
- END DO
- END DO
- END DO
- DEALLOCATE(ZNCLD,ZRC_OUT,ZRI_OUT)
-END IF
-!
-DEALLOCATE(ZEXNT)
-!
-GDOIT_2D(:) = .FALSE.
-!
-! Flags the columns for which the computations have to be performed
-!
-DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- IF (ZVIEW(IIJ) /= XUNDEF) GDOIT_2D(IIJ) = .TRUE.
- END DO
-END DO
-IDOIT_COL = COUNT( GDOIT_2D(:) ) ! number of larger scale columns
-!
-GDOIT(:,:) = SPREAD( GDOIT_2D(:),DIM=2,NCOPIES=KFLEV )
-IDOIT = IDOIT_COL*KFLEV
-ALLOCATE(ZWORK1(IDOIT))
-!
-! temperature profiles
-ZWORK1(:) = PACK( ZTAVE(:,:),MASK=GDOIT(:,:) )
-DEALLOCATE(ZTAVE)
-ALLOCATE(ZTAVE(IDOIT_COL,KFLEV))
-ZTAVE(:,:) = RESHAPE( ZWORK1(:),(/IDOIT_COL,KFLEV/) )
-!
-! vapor mixing ratio profiles
-ZWORK1(:) = PACK( ZQVAVE(:,:),MASK=GDOIT(:,:) )
-DEALLOCATE(ZQVAVE)
-ALLOCATE(ZQVAVE(IDOIT_COL,KFLEV))
-ZQVAVE(:,:) = RESHAPE( ZWORK1(:),(/IDOIT_COL,KFLEV/) )
-!
-! cloud emissivities
-ZWORK1(:) = PACK( ZCLDLD(:,:),MASK=GDOIT(:,:) )
-DEALLOCATE(ZCLDLD)
-ALLOCATE(ZCLDLD(IDOIT_COL,KFLEV))
-ZCLDLD(:,:) = RESHAPE( ZWORK1(:),(/IDOIT_COL,KFLEV/) )
-!
-ZWORK1(:) = PACK( ZCLDLU(:,:),MASK=GDOIT(:,:) )
-DEALLOCATE(ZCLDLU)
-ALLOCATE(ZCLDLU(IDOIT_COL,KFLEV))
-ZCLDLU(:,:) = RESHAPE( ZWORK1(:),(/IDOIT_COL,KFLEV/) )
-!
-! ozone content profiles
-ZWORK1(:) = PACK( ZO3AVE(:,:),MASK=GDOIT(:,:) )
-DEALLOCATE(ZO3AVE)
-ALLOCATE(ZO3AVE(IDOIT_COL,KFLEV))
-ZO3AVE(:,:) = RESHAPE( ZWORK1(:),(/IDOIT_COL,KFLEV/) )
-!
-! half-level variables
-ZWORK1(:) = PACK( ZPRES_HL(:,1:KFLEV),MASK=GDOIT(:,:) )
-DEALLOCATE(ZPRES_HL)
-ALLOCATE(ZPRES_HL(IDOIT_COL,KFLEV+1))
-ZPRES_HL(:,1:KFLEV) = RESHAPE( ZWORK1(:),(/IDOIT_COL,KFLEV/) )
-ZPRES_HL(:,KFLEV+1) = PSTATM(IKSTAE,2)*100.0
-!
-ZWORK1(:) = PACK( ZT_HL(:,1:KFLEV),MASK=GDOIT(:,:) )
-DEALLOCATE(ZT_HL)
-ALLOCATE(ZT_HL(IDOIT_COL,KFLEV+1))
-ZT_HL(:,1:KFLEV) = RESHAPE( ZWORK1(:),(/IDOIT_COL,KFLEV/) )
-ZT_HL(:,KFLEV+1) = PSTATM(IKSTAE,3)
-!
-! surface fields
-ALLOCATE(ZWORK3(IDOIT_COL))
-ZWORK3(:) = PACK( ZVIEW(:),MASK=GDOIT_2D(:) )
-DEALLOCATE(ZVIEW)
-ALLOCATE(ZVIEW(IDOIT_COL))
-ZVIEW(:) = ZWORK3(:)
-!
-ZWORK3(:) = PACK( ZREMIS(:),MASK=GDOIT_2D(:) )
-DEALLOCATE(ZREMIS)
-ALLOCATE(ZREMIS(IDOIT_COL))
-ZREMIS(:) = ZWORK3(:)
-!
-ZWORK3(:) = PACK( ZDT0(:),MASK=GDOIT_2D(:) )
-DEALLOCATE(ZDT0)
-ALLOCATE(ZDT0(IDOIT_COL))
-ZDT0(:) = ZWORK3(:)
-!
-DEALLOCATE(ZWORK1)
-DEALLOCATE(ZWORK3)
-!
-! radiation fields
-ALLOCATE(ZRADBC(IDOIT_COL,JPWVINT))
-ALLOCATE(ZRADBT(IDOIT_COL,JPWVINT))
-!
-IDIM = IDOIT_COL
-PRINT *,'KGEO =',KGEO,' IDIM =',IDIM
-!
-!* 6.2 CALLS THE ECMWF_RADIATION ROUTINES
-!
-! ***********************************************************
-! *CAUTION: Routine nbmvec is written in FORTRAN 77*
-! ***********************************************************
-!
-! mixing ratio -> specific humidity conversion
-ZQVAVE(:,:) = ZQVAVE(:,:) / (1.+ZQVAVE(:,:))
-!
-IF( IDIM <= KRAD_COLNBR ) THEN
- !
- ! there is less than KRAD_COLNBR verticals to be considered therefore
- ! no split of the arrays is performed
- !
- CALL NBMVEC( 1, IDIM, IDIM, KFLEV, IGL, ICABS, ING1, IUABS, &
- IH2O, ICO2, IO3, ICNT, IN2O, ICH4, ICO, IC11, IC12, ICFC, &
- IINIS, IENDS, ICONF, ICLOUD, IOVLP, GPVOIGT, GPTDEP, &
- ZTAVE, ZQVAVE, ZO3AVE, ZPRES_HL, ZT_HL, &
- ZVIEW, ZCLDLD, ZCLDLU, ZDT0, ZREMIS, ZRADBC, ZRADBT)
-ELSE
- !
- ! the splitting of the arrays will be performed
- !
- INUM_CALL = CEILING( REAL( IDIM ) / REAL( KRAD_COLNBR ) )
- IDIM_RESIDUE = IDIM
- DO JI_SPLIT = 1 , INUM_CALL
- IDIM_EFF = MIN( IDIM_RESIDUE,KRAD_COLNBR )
- !
- IF( JI_SPLIT == 1 .OR. JI_SPLIT == INUM_CALL ) THEN
- ALLOCATE( ZREMIS_SPLIT(IDIM_EFF))
- ALLOCATE( ZO3AVE_SPLIT(IDIM_EFF,KFLEV))
- ALLOCATE( ZT_HL_SPLIT(IDIM_EFF,KFLEV+1))
- ALLOCATE( ZPRES_HL_SPLIT(IDIM_EFF,KFLEV+1))
- ALLOCATE( ZQVAVE_SPLIT(IDIM_EFF,KFLEV))
- ALLOCATE( ZTAVE_SPLIT(IDIM_EFF,KFLEV))
- ALLOCATE( ZCLDLU_SPLIT(IDIM_EFF,KFLEV))
- ALLOCATE( ZCLDLD_SPLIT(IDIM_EFF,KFLEV))
- ALLOCATE( ZVIEW_SPLIT(IDIM_EFF))
- ALLOCATE( ZDT0_SPLIT(IDIM_EFF))
- ALLOCATE( ZRADBT_SPLIT(IDIM_EFF,JPWVINT))
- ALLOCATE( ZRADBC_SPLIT(IDIM_EFF,JPWVINT))
- END IF
- !
- ! fill the split arrays with their values
- ! taken from the full arrays
- !
- IBEG = IDIM-IDIM_RESIDUE+1
- IEND = IBEG+IDIM_EFF-1
- ZREMIS_SPLIT(:) = ZREMIS( IBEG:IEND )
- ZO3AVE_SPLIT(:,:) = ZO3AVE( IBEG:IEND ,:)
- ZT_HL_SPLIT(:,:) = ZT_HL( IBEG:IEND ,:)
- ZPRES_HL_SPLIT(:,:) = ZPRES_HL( IBEG:IEND ,:)
- ZQVAVE_SPLIT(:,:) = ZQVAVE( IBEG:IEND ,:)
- ZTAVE_SPLIT(:,:) = ZTAVE ( IBEG:IEND ,:)
- ZCLDLU_SPLIT(:,:) = ZCLDLU ( IBEG:IEND ,:)
- ZCLDLD_SPLIT(:,:) = ZCLDLD ( IBEG:IEND ,:)
- ZVIEW_SPLIT(:) = ZVIEW ( IBEG:IEND )
- ZDT0_SPLIT(:) = ZDT0 ( IBEG:IEND )
- !
- ! call ECMWF_radiation with the split arrays
- !
- CALL NBMVEC( 1, IDIM_EFF, IDIM_EFF, KFLEV, IGL, ICABS, ING1, IUABS,&
- IH2O, ICO2, IO3, ICNT, IN2O, ICH4, ICO, IC11, IC12, ICFC, &
- IINIS, IENDS, ICONF, ICLOUD, IOVLP, GPVOIGT, GPTDEP, &
- ZTAVE_SPLIT, ZQVAVE_SPLIT, ZO3AVE_SPLIT, &
- ZPRES_HL_SPLIT, ZT_HL_SPLIT, &
- ZVIEW_SPLIT, ZCLDLD_SPLIT, ZCLDLU_SPLIT, ZDT0_SPLIT, &
- ZREMIS_SPLIT, ZRADBC_SPLIT, ZRADBT_SPLIT)
- !
- ! fill the full output arrays with the split arrays
- !
- ZRADBT( IBEG:IEND ,:) = ZRADBT_SPLIT(:,:)
- ZRADBC( IBEG:IEND ,:) = ZRADBC_SPLIT(:,:)
- !
- IDIM_RESIDUE = IDIM_RESIDUE - IDIM_EFF
- !
- ! desallocation of the split arrays
- !
- IF( JI_SPLIT >= INUM_CALL-1 ) THEN
- DEALLOCATE(ZREMIS_SPLIT)
- DEALLOCATE(ZO3AVE_SPLIT)
- DEALLOCATE(ZT_HL_SPLIT)
- DEALLOCATE(ZPRES_HL_SPLIT)
- DEALLOCATE(ZQVAVE_SPLIT)
- DEALLOCATE(ZTAVE_SPLIT)
- DEALLOCATE(ZCLDLU_SPLIT)
- DEALLOCATE(ZCLDLD_SPLIT)
- DEALLOCATE(ZVIEW_SPLIT)
- DEALLOCATE(ZDT0_SPLIT)
- DEALLOCATE(ZRADBT_SPLIT)
- DEALLOCATE(ZRADBC_SPLIT)
- END IF
- END DO
-END IF
-!
-DEALLOCATE(ZTAVE,ZQVAVE,ZO3AVE)
-DEALLOCATE(ZPRES_HL,ZT_HL)
-DEALLOCATE(ZREMIS)
-DEALLOCATE(ZDT0)
-DEALLOCATE(ZCLDLD,ZCLDLU)
-DEALLOCATE(ZVIEW)
-!
-ZRADBT = ZRADBT / XPI
-ALLOCATE(ZRADFT(IDIM,JPCAN))
-CALL MAKE_RADSAT(KYEARF, KMONTHF, KDAYF, PSECF, &
- KGEO, IDIM, ZRADBT, ZRADFT)
-DEALLOCATE(ZRADBT)
-DEALLOCATE(ZRADBC)
-!
-ALLOCATE(ZWORK1(IDIM*JPCAN))
-ZWORK1(:) = PACK( ZRADFT(:,:),MASK=.TRUE. )
-ALLOCATE(ZZRADFT(KDLON,JPCAN))
-ZZRADFT(:,:) = UNPACK( ZWORK1(:),MASK=GDOIT(:,1:JPCAN),FIELD=XUNDEF )
-DEALLOCATE(ZRADFT)
-DEALLOCATE(ZWORK1)
-!
-PIRBT = XUNDEF
-PWVBT = XUNDEF
-DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- PIRBT(JI,JJ) = ZZRADFT(IIJ,1)
- PWVBT(JI,JJ) = ZZRADFT(IIJ,2)
- END DO
-END DO
-DEALLOCATE(ZZRADFT)
-!
-END SUBROUTINE RADTR_SATEL
--
GitLab