suphy3.F90

Go to the documentation of this file.

!OPTIONS XOPT(NOEVAL)
SUBROUTINE suphy3(KULOUT)

!**** *SUPHY3*   - Initialize common YOMPHY3 physics radiative
!                  constants

!     Purpose.
!     --------
!           Initialize YOMPHY3, the common that contains the parameters
!           for the radiation part of the physics of the model.

!**   Interface.
!     ----------
!        *CALL* *SUPHY3(KULOUT)

!        Explicit arguments :
!        --------------------
!        KULOUT : Logical unit for the output

!        Implicit arguments :
!        --------------------
!        COMMON YOMPHY3

!     Method.
!     -------
!        See documentation

!     Externals.
!     ----------

!     Reference.
!     ----------
!        Documentation ARPEGE

!     Author.
!     -------
!        J.-F. Geleyn .

!     Modifications.
!     --------------
!        Original : 90-9-1
!        Ajout de GCE4 et
!         modification de toutes les constantes optiques : 91-2-1
!        Ajout des nuages de glace : 92-04, L. Labbe.
!        Modified by R. EL Khatib : 93-04-02 Set-up defaults controled by LECMWF
!        Modified 97-04-17 J.M. Piriou: radiative coefficients default values, and new QSUSX default.
!        Modified 2000-08 R. Randriamampianina, J.F. Geleyn et J.M. Piriou: change infra-red interaction between layers (GIREC*).
!        Modified 2000-12-12 by E. Bazile: CYCORA's default value.
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        R.Brozkova    24-Sep-2006 ALARO-0 (new cloud model)
!     ------------------------------------------------------------------

USE parkind1  ,ONLY : jpim     ,jprb
USE yomhook   ,ONLY : lhook,   dr_hook

! Ce qui concerne NULNAM commente par MPL le 15.04.09
!USE YOMLUN   , ONLY : NULNAM
USE yomct0b  , ONLY : lecmwf
USE yomphy   , ONLY : lclsatur
USE yomphy3  , ONLY : gca      ,gcb      ,gcc      ,vdp      ,&
 & vnp      ,bsfsa    ,bsfsi    ,bsfsn    ,bsfta    ,&
 & bsfti    ,bsftn    ,earrt    ,eoasa    ,eoasi    ,&
 & eoasn    ,eoata    ,eoati    ,eoatn    ,eodsa    ,&
 & eodsi    ,eodsn    ,eodta    ,eodti    ,eodtn    ,&
 & eoray    ,gcd4     ,gce4     ,qco2     ,qlimi    ,&
 & qlip0    ,rii0     ,usaa     ,usai     ,&
 & usan     ,usba     ,usbi     ,usbn     ,&
 & girec1   ,girec2   ,girec3   ,girec4   ,&  
 & fcm_del_a,fcm_del_d,fcm_mu_a ,fcm_mu_d ,fcm_n_i  ,&
 & fcm_n_l  ,fcm_p_ai ,fcm_p_al ,fcm_p_di ,fcm_p_dl ,&
 & fcm_p_gi ,fcm_p_gl ,fcm_q_ai ,fcm_q_al ,fcm_q_di ,&
 & fcm_q_dl ,fcm_q_gi ,fcm_q_gl ,n_spband ,rexp_neb

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KULOUT 
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "posnam.intfb.h"

#include "namphy3.h"
!     ------------------------------------------------------------------

!*       1.    Set default values.
!              -------------------

!        1.1 Set implicit default values

IF (lhook) CALL dr_hook('SUPHY3',0,zhook_handle)
bsfsa=.3490_jprb
bsfsi=.3238_jprb
bsfsn=.3300_jprb
bsfta=.3471_jprb
bsfti=.3231_jprb
bsftn=.3584_jprb
earrt=0.001324_jprb
eoasa=.6727e-01_jprb
eoasi=.1692e-01_jprb
eoasn=.3353e-01_jprb
eoata=.5037e-01_jprb
eoati=.3455e+01_jprb
eoatn=.9077e+01_jprb
eodsa=.3665e+00_jprb
eodsi=.1406e+01_jprb
eodsn=.6558e+01_jprb
eodta=.1766e-01_jprb
eodti=.8435e+00_jprb
eodtn=.4319e+01_jprb
eoray=.8606e-06_jprb
gca(1)=.8041e-01_jprb
gca(2)=.1456e+00_jprb
gca(3)=.4787e+01_jprb
gca(4)=.2102e+04_jprb
gca(5)=.1334e+01_jprb
gca(6)=.1551e-04_jprb
gcb(1)=.8968e+07_jprb
gcb(2)=.2413e+10_jprb
gcb(3)=.3548e+05_jprb
gcb(4)=.6370e+10_jprb
gcb(5)=.8499e+11_jprb
gcb(6)=.1012e+06_jprb
gcc(1)=.5925e-10_jprb
gcc(2)=.1842e-10_jprb
gcc(3)=.2532e-07_jprb
gcc(4)=.1953e+07_jprb
gcc(5)=.1734e-11_jprb
gcc(6)=.1225e-16_jprb
gcd4=.3608e-69_jprb
gce4=.7563e+04_jprb
girec1=0.0_jprb
girec2=0.0_jprb
girec3=0.0_jprb
girec4=0.0_jprb
qco2=.5366e-03_jprb
qlimi=15000._jprb
qlip0=8.e+06_jprb
usaa=-.3020_jprb
usai=-.3524_jprb
usan=-.3400_jprb
usba=0._jprb
usbi=0._jprb
usbn=0._jprb
vdp(1,1)=.21868e+02_jprb
vdp(2,1)=.17453e+02_jprb
vdp(3,1)=.68918e+00_jprb
vdp(4,1)=.23456e-03_jprb
vdp(5,1)=.22317e-09_jprb
vdp(1,2)=.48401e+02_jprb
vdp(2,2)=.18648e+02_jprb
vdp(3,2)=.35199e-01_jprb
vdp(4,2)=.63691e-06_jprb
vdp(5,2)=.86395e-13_jprb
vdp(1,3)=.76948e+02_jprb
vdp(2,3)=.41056e+01_jprb
vdp(3,3)=.42667e-03_jprb
vdp(4,3)=0._jprb
vdp(5,3)=0._jprb
vdp(1,4)=.27241e+03_jprb
vdp(2,4)=.57091e+04_jprb
vdp(3,4)=.14393e+05_jprb
vdp(4,4)=.29879e+04_jprb
vdp(5,4)=.25382e+02_jprb
vdp(1,5)=.86942e+02_jprb
vdp(2,5)=.32186e+03_jprb
vdp(3,5)=.10775e+03_jprb
vdp(4,5)=.21261e+01_jprb
vdp(5,5)=.40003e-02_jprb
vdp(1,6)=.24408e+02_jprb
vdp(2,6)=.81919e+01_jprb
vdp(3,6)=.72193e+01_jprb
vdp(4,6)=.56230e+00_jprb
vdp(5,6)=.25384e-02_jprb
vnp(1,1)=.69926e+01_jprb
vnp(2,1)=.63915e+00_jprb
vnp(3,1)=.28896e-03_jprb
vnp(4,1)=.10050e-08_jprb
vnp(5,1)=.99037e-16_jprb
vnp(1,2)=.31105e+01_jprb
vnp(2,2)=.14225e-01_jprb
vnp(3,2)=.69355e-06_jprb
vnp(4,2)=.36087e-12_jprb
vnp(5,2)=.44113e-20_jprb
vnp(1,3)=.23659e+01_jprb
vnp(2,3)=.11139e-02_jprb
vnp(3,3)=.10618e-05_jprb
vnp(4,3)=0._jprb
vnp(5,3)=0._jprb
vnp(1,4)=.19810e+03_jprb
vnp(2,4)=.46954e+04_jprb
vnp(3,4)=.22512e+04_jprb
vnp(4,4)=.52461e+02_jprb
vnp(5,4)=.11645e+00_jprb
vnp(1,5)=.46348e+02_jprb
vnp(2,5)=.35630e+02_jprb
vnp(3,5)=.33005e+01_jprb
vnp(4,5)=.18045e-01_jprb
vnp(5,5)=.88667e-05_jprb
vnp(1,6)=.47413e+01_jprb
vnp(2,6)=.16334e+01_jprb
vnp(3,6)=.48164e+00_jprb
vnp(4,6)=.56140e-02_jprb
vnp(5,6)=.67790e-04_jprb

! Default values for cloud model - first index denotes spectral band:
!   1 - solar
!   2 - thermal
fcm_del_a(1)  =  9.55496e-01_jprb
fcm_del_a(2)  =  1.79152e+02_jprb
fcm_del_d(1)  =  5.72959e+01_jprb
fcm_del_d(2)  =  2.00159e+02_jprb
fcm_mu_a(1)   =  8.66200e-01_jprb
fcm_mu_a(2)   =  6.65532e-01_jprb
fcm_mu_d(1)   =  1.00000e+00_jprb
fcm_mu_d(2)   =  6.70517e-01_jprb
fcm_n_i       =  1.00000e-01_jprb
fcm_n_l       =  1.00000e-01_jprb
fcm_p_ai(1,0) =  1.48920e+01_jprb
fcm_p_ai(1,1) = -3.71379e+01_jprb
fcm_p_ai(1,2) =  0.00000e+00_jprb
fcm_p_ai(1,3) =  0.00000e+00_jprb
fcm_p_ai(2,0) =  9.76920e+00_jprb
fcm_p_ai(2,1) = -7.54840e+00_jprb
fcm_p_ai(2,2) =  0.00000e+00_jprb
fcm_p_ai(2,3) =  0.00000e+00_jprb
fcm_p_al(1,0) =  1.42062e+00_jprb
fcm_p_al(1,1) = -3.54037e+00_jprb
fcm_p_al(1,2) =  1.73535e+00_jprb
fcm_p_al(1,3) =  0.00000e+00_jprb
fcm_p_al(2,0) =  5.08522e+00_jprb
fcm_p_al(2,1) = -1.08144e+01_jprb
fcm_p_al(2,2) =  5.16331e+00_jprb
fcm_p_al(2,3) =  0.00000e+00_jprb
fcm_p_di(1,0) =  1.30487e+01_jprb
fcm_p_di(1,1) =  1.98670e+01_jprb
fcm_p_di(1,2) = -5.08578e+01_jprb
fcm_p_di(1,3) =  0.00000e+00_jprb
fcm_p_di(2,0) =  1.23173e+01_jprb
fcm_p_di(2,1) = -3.32808e+01_jprb
fcm_p_di(2,2) =  5.77295e+01_jprb
fcm_p_di(2,3) = -7.35728e+01_jprb
fcm_p_dl(1,0) =  4.68646e+00_jprb
fcm_p_dl(1,1) = -8.77652e+00_jprb
fcm_p_dl(1,2) =  2.12789e+00_jprb
fcm_p_dl(1,3) =  0.00000e+00_jprb
fcm_p_dl(2,0) =  4.52292e+00_jprb
fcm_p_dl(2,1) = -1.43327e+01_jprb
fcm_p_dl(2,2) =  1.16650e+01_jprb
fcm_p_dl(2,3) =  0.00000e+00_jprb
fcm_p_gi(1,0) = -2.01472e+00_jprb
fcm_p_gi(1,1) =  9.16284e+01_jprb
fcm_p_gi(1,2) =  7.82275e+01_jprb
fcm_p_gi(1,3) =  0.00000e+00_jprb
fcm_p_gi(2,0) = -7.55124e-01_jprb
fcm_p_gi(2,1) = -4.68837e+00_jprb
fcm_p_gi(2,2) =  6.72877e+01_jprb
fcm_p_gi(2,3) =  0.00000e+00_jprb
fcm_p_gl(1,0) =  8.82686e-01_jprb
fcm_p_gl(1,1) = -2.02445e+00_jprb
fcm_p_gl(1,2) =  1.45259e+00_jprb
fcm_p_gl(1,3) =  0.00000e+00_jprb
fcm_p_gl(2,0) =  1.93784e-01_jprb
fcm_p_gl(2,1) = -6.07676e-01_jprb
fcm_p_gl(2,2) =  5.37734e-01_jprb
fcm_p_gl(2,3) =  0.00000e+00_jprb
fcm_q_ai(1,1) =  1.86588e+01_jprb
fcm_q_ai(1,2) =  0.00000e+00_jprb
fcm_q_ai(1,3) =  0.00000e+00_jprb
fcm_q_ai(2,1) =  2.78063e+00_jprb
fcm_q_ai(2,2) =  0.00000e+00_jprb
fcm_q_ai(2,3) =  0.00000e+00_jprb
fcm_q_al(1,1) = -2.81210e+00_jprb
fcm_q_al(1,2) =  2.35758e+00_jprb
fcm_q_al(1,3) =  0.00000e+00_jprb
fcm_q_al(2,1) = -2.31252e+00_jprb
fcm_q_al(2,2) =  1.56848e+00_jprb
fcm_q_al(2,3) =  0.00000e+00_jprb
fcm_q_di(1,1) =  1.04582e+01_jprb
fcm_q_di(1,2) =  6.15641e+00_jprb
fcm_q_di(1,3) =  0.00000e+00_jprb
fcm_q_di(2,1) =  1.18370e+00_jprb
fcm_q_di(2,2) =  2.23187e+00_jprb
fcm_q_di(2,3) =  7.00424e+00_jprb
fcm_q_dl(1,1) = -2.18205e+00_jprb
fcm_q_dl(1,2) =  1.34831e+00_jprb
fcm_q_dl(1,3) =  0.00000e+00_jprb
fcm_q_dl(2,1) = -3.12310e+00_jprb
fcm_q_dl(2,2) =  2.57959e+00_jprb
fcm_q_dl(2,3) =  0.00000e+00_jprb
fcm_q_gi(1,1) =  7.89999e+01_jprb
fcm_q_gi(1,2) =  5.24929e+01_jprb
fcm_q_gi(1,3) =  0.00000e+00_jprb
fcm_q_gi(2,1) =  4.93801e+00_jprb
fcm_q_gi(2,2) =  2.38096e+01_jprb
fcm_q_gi(2,3) =  0.00000e+00_jprb
fcm_q_gl(1,1) = -2.20830e+00_jprb
fcm_q_gl(1,2) =  1.39832e+00_jprb
fcm_q_gl(1,3) =  0.00000e+00_jprb
fcm_q_gl(2,1) = -3.27770e+00_jprb
fcm_q_gl(2,2) =  2.78446e+00_jprb
fcm_q_gl(2,3) =  0.00000e+00_jprb
rexp_neb      = 8.0_jprb

!        1.2 Modify default values according to LECMWF

IF (lecmwf) THEN
ELSE
ENDIF

!     Remark : the values or RII0 is calculated and not set up

!     ------------------------------------------------------------------

!*       2.    Modify default values.
!              ----------------------

! Ce qui concerne NAMPHY3 commente par MPL le 15.04.09
!CALL POSNAM(NULNAM,'NAMPHY3')
!READ(NULNAM,NAMPHY3)
!     ------------------------------------------------------------------

!*       3.    Print final values.
!              -------------------

WRITE(unit=kulout,fmt='('' COMMON YOMPHY3 '')')
WRITE(unit=kulout,fmt='('' BSFSA = '',E10.4,'' BSFSI = '',E10.4 &
 & ,'' BSFSN = '',E10.4,'' BSFTA = '',E10.4,'' BSFTI = '',E10.4,/&
 & ,'' BSFTN = '',E10.4,'' EARRT = '',E10.4,'' EOASA = ''&
 & ,E10.4,'' EOASI = '',E10.4,'' EOASN = '',E10.4 &
 & ,'' EOATA = '',E10.4,/,'' EOATI = '',E10.4,'' EOATN = '',E10.4 &
 & ,'' EODSA = '',E10.4,'' EODSI = '',E10.4,'' EODSN = '',E10.4 &
 & ,'' EODTA = '',E10.4,/,'' EODTI = '',E10.4 &
 & ,'' EODTN = '',E10.4,'' EORAY = '',E10.4,/&
 & ,'' GCA(6) = '',6E11.4,/,'' GCB(6) = '',6E11.4,/,'' GCC(6) = ''&
 & ,6E11.4,/,'' GCD4 = '',E11.4,'' GCE4 = '',E11.4,/&
 & ,'' QCO2 = '',E10.4,'' QLIP0 = '',E10.4 &
 & ,'' USAA = '',E10.4,'' USAI = '',E10.4,'' USAN = '',E10.4 &
 & ,'' USBA = '',E10.4,/,'' USBI = '',E10.4,'' USBN = '',E10.4,/&
 & ,'' VDP(5,6) = '',5E12.5,/,5(12X,5E12.5,/)&
 & ,'' VNP(5,6) = '',5E12.5,/,5(12X,5E12.5,/)&
 & ,'' QLIMI = '',E10.4 &
 & ,'' GIREC1 = '',E10.4,'' GIREC2 = '',E10.4,'' GIREC3 = '',E10.4 &
 & ,'' GIREC4 = '',E10.4 &
 & )')&
 & bsfsa,bsfsi,bsfsn,bsfta,bsfti,bsftn,earrt,eoasa,eoasi,eoasn,&
 & eoata,eoati,eoatn,eodsa,eodsi,eodsn,eodta,eodti,eodtn,eoray,&
 & gca,gcb,gcc,gcd4,gce4,qco2,qlip0,usaa,usai,usan,usba,usbi,usbn,&
 & vdp,vnp,qlimi,girec1,girec2,girec3,girec4  

IF (lclsatur) THEN
  WRITE(kulout,'('' N_SPBAND = '',I2,'' REXP_NEB = '',F5.2)') &
   & n_spband,rexp_neb
  WRITE(kulout,'('' FCM_DEL_A(:)   ='',2(1X,ES12.5))') fcm_del_a(:)
  WRITE(kulout,'('' FCM_DEL_D(:)   ='',2(1X,ES12.5))') fcm_del_d(:)
  WRITE(kulout,'('' FCM_MU_A (:)   ='',2(1X,ES12.5))') fcm_mu_a(:)
  WRITE(kulout,'('' FCM_MU_D (:)   ='',2(1X,ES12.5))') fcm_mu_d(:)
  WRITE(kulout,'('' FCM_N_I        ='',1X,ES12.5)')    fcm_n_i
  WRITE(kulout,'('' FCM_N_L        ='',1X,ES12.5)')    fcm_n_l
  WRITE(kulout,'('' FCM_P_AI (:,0) ='',2(1X,ES12.5))') fcm_p_ai(:,0)
  WRITE(kulout,'('' FCM_P_AI (:,1) ='',2(1X,ES12.5))') fcm_p_ai(:,1)
  WRITE(kulout,'('' FCM_P_AI (:,2) ='',2(1X,ES12.5))') fcm_p_ai(:,2)
  WRITE(kulout,'('' FCM_P_AI (:,3) ='',2(1X,ES12.5))') fcm_p_ai(:,3)
  WRITE(kulout,'('' FCM_P_AL (:,0) ='',2(1X,ES12.5))') fcm_p_al(:,0)
  WRITE(kulout,'('' FCM_P_AL (:,1) ='',2(1X,ES12.5))') fcm_p_al(:,1)
  WRITE(kulout,'('' FCM_P_AL (:,2) ='',2(1X,ES12.5))') fcm_p_al(:,2)
  WRITE(kulout,'('' FCM_P_AL (:,3) ='',2(1X,ES12.5))') fcm_p_al(:,3)
  WRITE(kulout,'('' FCM_P_DI (:,0) ='',2(1X,ES12.5))') fcm_p_di(:,0)
  WRITE(kulout,'('' FCM_P_DI (:,1) ='',2(1X,ES12.5))') fcm_p_di(:,1)
  WRITE(kulout,'('' FCM_P_DI (:,2) ='',2(1X,ES12.5))') fcm_p_di(:,2)
  WRITE(kulout,'('' FCM_P_DI (:,3) ='',2(1X,ES12.5))') fcm_p_di(:,3)
  WRITE(kulout,'('' FCM_P_DL (:,0) ='',2(1X,ES12.5))') fcm_p_dl(:,0)
  WRITE(kulout,'('' FCM_P_DL (:,1) ='',2(1X,ES12.5))') fcm_p_dl(:,1)
  WRITE(kulout,'('' FCM_P_DL (:,2) ='',2(1X,ES12.5))') fcm_p_dl(:,2)
  WRITE(kulout,'('' FCM_P_DL (:,3) ='',2(1X,ES12.5))') fcm_p_dl(:,3)
  WRITE(kulout,'('' FCM_P_GI (:,0) ='',2(1X,ES12.5))') fcm_p_gi(:,0)
  WRITE(kulout,'('' FCM_P_GI (:,1) ='',2(1X,ES12.5))') fcm_p_gi(:,1)
  WRITE(kulout,'('' FCM_P_GI (:,2) ='',2(1X,ES12.5))') fcm_p_gi(:,2)
  WRITE(kulout,'('' FCM_P_GI (:,3) ='',2(1X,ES12.5))') fcm_p_gi(:,3)
  WRITE(kulout,'('' FCM_P_GL (:,0) ='',2(1X,ES12.5))') fcm_p_gl(:,0)
  WRITE(kulout,'('' FCM_P_GL (:,1) ='',2(1X,ES12.5))') fcm_p_gl(:,1)
  WRITE(kulout,'('' FCM_P_GL (:,2) ='',2(1X,ES12.5))') fcm_p_gl(:,2)
  WRITE(kulout,'('' FCM_P_GL (:,3) ='',2(1X,ES12.5))') fcm_p_gl(:,3)
  WRITE(kulout,'('' FCM_Q_AI (:,1) ='',2(1X,ES12.5))') fcm_q_ai(:,1)
  WRITE(kulout,'('' FCM_Q_AI (:,2) ='',2(1X,ES12.5))') fcm_q_ai(:,2)
  WRITE(kulout,'('' FCM_Q_AI (:,3) ='',2(1X,ES12.5))') fcm_q_ai(:,3)
  WRITE(kulout,'('' FCM_Q_AL (:,1) ='',2(1X,ES12.5))') fcm_q_al(:,1)
  WRITE(kulout,'('' FCM_Q_AL (:,2) ='',2(1X,ES12.5))') fcm_q_al(:,2)
  WRITE(kulout,'('' FCM_Q_AL (:,3) ='',2(1X,ES12.5))') fcm_q_al(:,3)
  WRITE(kulout,'('' FCM_Q_DI (:,1) ='',2(1X,ES12.5))') fcm_q_di(:,1)
  WRITE(kulout,'('' FCM_Q_DI (:,2) ='',2(1X,ES12.5))') fcm_q_di(:,2)
  WRITE(kulout,'('' FCM_Q_DI (:,3) ='',2(1X,ES12.5))') fcm_q_di(:,3)
  WRITE(kulout,'('' FCM_Q_DL (:,1) ='',2(1X,ES12.5))') fcm_q_dl(:,1)
  WRITE(kulout,'('' FCM_Q_DL (:,2) ='',2(1X,ES12.5))') fcm_q_dl(:,2)
  WRITE(kulout,'('' FCM_Q_DL (:,3) ='',2(1X,ES12.5))') fcm_q_dl(:,3)
  WRITE(kulout,'('' FCM_Q_GI (:,1) ='',2(1X,ES12.5))') fcm_q_gi(:,1)
  WRITE(kulout,'('' FCM_Q_GI (:,2) ='',2(1X,ES12.5))') fcm_q_gi(:,2)
  WRITE(kulout,'('' FCM_Q_GI (:,3) ='',2(1X,ES12.5))') fcm_q_gi(:,3)
  WRITE(kulout,'('' FCM_Q_GL (:,1) ='',2(1X,ES12.5))') fcm_q_gl(:,1)
  WRITE(kulout,'('' FCM_Q_GL (:,2) ='',2(1X,ES12.5))') fcm_q_gl(:,2)
  WRITE(kulout,'('' FCM_Q_GL (:,3) ='',2(1X,ES12.5))') fcm_q_gl(:,3)
ENDIF
!     ------------------------------------------------------------------

IF (lhook) CALL dr_hook('SUPHY3',1,zhook_handle)
END SUBROUTINE suphy3