Changeset 5154 for LMDZ6/branches


Ignore:
Timestamp:
Jul 31, 2024, 9:54:47 PM (5 months ago)
Author:
abarral
Message:

Fix ecrad & rrtm compilation

Location:
LMDZ6/branches/Amaury_dev/libf/phylmd
Files:
34 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/cosp_output_write_mod.F90

    r5133 r5154  
    33!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    44   MODULE cosp_output_write_mod
    5  
     5
    66   USE cosp_output_mod
    7  
     7
    88   IMPLICIT NONE
    99
    … …  
    2828    USE wxios, only: wxios_closedef
    2929    USE lmdz_xios, only: xios_update_calendar, xios_field_is_active, using_xios
    30   IMPLICIT NONE 
     30  IMPLICIT NONE
    3131!!! Variables d'entree
    3232  integer               :: itap, Nlevlmdz, Ncolumns, Npoints
    … …  
    6767       itau_wcosp = itau_phy + itap + start_time * day_step_phy
    6868        if (prt_level >= 10) then
    69              WRITE(lunout,*)'itau_wcosp, itap, start_time, day_step_phy =', & 
     69             WRITE(lunout,*)'itau_wcosp, itap, start_time, day_step_phy =', &
    7070                             itau_wcosp, itap, start_time, day_step_phy
    7171        endif
    … …  
    7878
    7979    ok_sync = .TRUE.
    80    
     80
    8181!DO iinit=1, iinitend
    8282! AI sept 2014 cette boucle supprimee
    … …  
    9393!         WRITE(lunout,*)'Apell xios_update_calendar cosp_varsdefined iinitend ', &
    9494!                         cosp_varsdefined,iinitend
    95 !   endif 
     95!   endif
    9696!    CALL xios_update_calendar(itau_wcosp)
    9797!ENDIF
    … …  
    102102!!!! Sorties Calipso
    103103 if (cfg%Llidar_sim) then
    104 !!! AI 02 2018 
     104!!! AI 02 2018
    105105! Traitement missing_val
    106106   where(stlidar%lidarcld == R_UNDEF) stlidar%lidarcld = missing_val
    107    where(stlidar%proftemp == R_UNDEF) stlidar%proftemp = missing_val   !TIBO 
     107   where(stlidar%proftemp == R_UNDEF) stlidar%proftemp = missing_val   !TIBO
    108108   where(stlidar%profSR == R_UNDEF) stlidar%profSR = missing_val       !TIBO2
    109    where(sglidar%beta_mol == R_UNDEF) sglidar%beta_mol = missing_val 
    110    where(sglidar%beta_tot == R_UNDEF) sglidar%beta_tot = missing_val 
     109   where(sglidar%beta_mol == R_UNDEF) sglidar%beta_mol = missing_val
     110   where(sglidar%beta_tot == R_UNDEF) sglidar%beta_tot = missing_val
    111111   where(stlidar%cldlayer == R_UNDEF) stlidar%cldlayer = missing_val
    112112   where(stlidar%cldtype == R_UNDEF) stlidar%cldtype = missing_val     !OPAQ
    … …  
    119119   where(stlidar%lidarcldtype == R_UNDEF) stlidar%lidarcldtype = missing_val   !OPAQ
    120120   where(stlidar%lidarcldtmp == R_UNDEF) stlidar%lidarcldtmp = missing_val
    121  
     121
    122122!   print*,'Appel histwrite2d_cosp'
    123123   if (cfg%Lcllcalipso) CALL histwrite2d_cosp(o_cllcalipso,stlidar%cldlayer(:,1))
    124124   if (cfg%Lclhcalipso) CALL histwrite2d_cosp(o_clhcalipso,stlidar%cldlayer(:,3))
    125    if (cfg%Lclmcalipso) CALL histwrite2d_cosp(o_clmcalipso,stlidar%cldlayer(:,2)) 
     125   if (cfg%Lclmcalipso) CALL histwrite2d_cosp(o_clmcalipso,stlidar%cldlayer(:,2))
    126126   if (cfg%Lcltcalipso) CALL histwrite2d_cosp(o_cltcalipso,stlidar%cldlayer(:,4))
    127127   if (cfg%Lclcalipso) CALL histwrite3d_cosp(o_clcalipso,stlidar%lidarcld,nvert)
    … …  
    182182   if (cfg%LparasolRefl) CALL histwrite3d_cosp(o_parasol_refl,stlidar%parasolrefl,nvertp)
    183183
    184   if (cfg%LparasolRefl) then 
     184  if (cfg%LparasolRefl) then
    185185    do k=1,PARASOL_NREFL
    186186     do ip=1, Npoints
    … …  
    202202     if (cfg%Latb532) CALL histwrite4d_cosp(o_atb532,sglidar%beta_tot)
    203203   ELSE
    204      if (cfg%Latb532) then 
    205        do icl=1,Ncolumns 
     204     if (cfg%Latb532) then
     205       do icl=1,Ncolumns
    206206          CALL histwrite3d_cosp(o_atb532,sglidar%beta_tot(:,icl,:),nvertmcosp,icl)
    207207       enddo
    208      endif 
     208     endif
    209209   ENDIF
    210210
    211    if (cfg%LlidarBetaMol532) CALL histwrite3d_cosp(o_beta_mol532,sglidar%beta_mol,nvertmcosp) 
     211   if (cfg%LlidarBetaMol532) CALL histwrite3d_cosp(o_beta_mol532,sglidar%beta_mol,nvertmcosp)
    212212
    213213 endif !Lidar
    … …  
    259259  where(isccp%fq_isccp == R_UNDEF) isccp%fq_isccp = missing_val
    260260  where(isccp%boxtau == R_UNDEF) isccp%boxtau = missing_val
    261   where(isccp%boxptop == R_UNDEF) isccp%boxptop = missing_val 
     261  where(isccp%boxptop == R_UNDEF) isccp%boxptop = missing_val
    262262
    263263   CALL histwrite2d_cosp(o_sunlit,gbx%sunlit)
    … …  
    267267     if (cfg%Lclisccp) then
    268268       do icl=1,7
    269          CALL histwrite3d_cosp(o_clisccp2,isccp%fq_isccp(:,icl,:),nvertisccp,icl) 
     269         CALL histwrite3d_cosp(o_clisccp2,isccp%fq_isccp(:,icl,:),nvertisccp,icl)
    270270       enddo
    271271     endif
    … …  
    273273
    274274   if (cfg%Lboxtauisccp) CALL histwrite3d_cosp(o_boxtauisccp,isccp%boxtau,nvertcol)
    275    if (cfg%Lboxptopisccp) CALL histwrite3d_cosp(o_boxptopisccp,isccp%boxptop,nvertcol) 
    276    if (cfg%Lcltisccp) CALL histwrite2d_cosp(o_tclisccp,isccp%totalcldarea) 
    277    if (cfg%Lpctisccp) CALL histwrite2d_cosp(o_ctpisccp,isccp%meanptop) 
    278    if (cfg%Ltauisccp) CALL histwrite2d_cosp(o_tauisccp,isccp%meantaucld) 
    279    if (cfg%Lalbisccp) CALL histwrite2d_cosp(o_albisccp,isccp%meanalbedocld) 
    280    if (cfg%Lmeantbisccp) CALL histwrite2d_cosp(o_meantbisccp,isccp%meantb) 
     275   if (cfg%Lboxptopisccp) CALL histwrite3d_cosp(o_boxptopisccp,isccp%boxptop,nvertcol)
     276   if (cfg%Lcltisccp) CALL histwrite2d_cosp(o_tclisccp,isccp%totalcldarea)
     277   if (cfg%Lpctisccp) CALL histwrite2d_cosp(o_ctpisccp,isccp%meanptop)
     278   if (cfg%Ltauisccp) CALL histwrite2d_cosp(o_tauisccp,isccp%meantaucld)
     279   if (cfg%Lalbisccp) CALL histwrite2d_cosp(o_albisccp,isccp%meanalbedocld)
     280   if (cfg%Lmeantbisccp) CALL histwrite2d_cosp(o_meantbisccp,isccp%meantb)
    281281   if (cfg%Lmeantbclrisccp) CALL histwrite2d_cosp(o_meantbclrisccp,isccp%meantbclr)
    282282 endif ! Isccp
    … …  
    294294   ELSE
    295295     if (cfg%LclMISR) then
    296       do icl=1,7 
     296      do icl=1,7
    297297        CALL histwrite3d_cosp(o_clMISR,misr%fq_MISR(:,icl,:),nvertmisr,icl)
    298298      enddo
    … …  
    329329        modis%Cloud_Top_Pressure_Total_Mean = missing_val
    330330  where(modis%Liquid_Water_Path_Mean == R_UNDEF) &
    331         modis%Liquid_Water_Path_Mean = missing_val 
     331        modis%Liquid_Water_Path_Mean = missing_val
    332332  where(modis%Ice_Water_Path_Mean == R_UNDEF) &
    333333        modis%Ice_Water_Path_Mean = missing_val
    … …  
    335335  where(modis%Optical_Thickness_Total_LogMean == R_UNDEF) &
    336336          modis%Optical_Thickness_Total_LogMean = missing_val
    337            
     337
    338338  where(modis%Optical_Thickness_Water_LogMean == R_UNDEF) &
    339339          modis%Optical_Thickness_Water_LogMean = missing_val
    … …  
    341341  where(modis%Optical_Thickness_Ice_LogMean == R_UNDEF) &
    342342          modis%Optical_Thickness_Ice_LogMean = missing_val
    343    
     343
    344344  if (cfg%Lcllmodis) CALL histwrite2d_cosp(o_cllmodis,modis%Cloud_Fraction_Low_Mean)
    345345  if (cfg%Lclhmodis) CALL histwrite2d_cosp(o_clhmodis,modis%Cloud_Fraction_High_Mean)
    … …  
    351351  if (cfg%Ltauwmodis) CALL histwrite2d_cosp(o_tauwmodis,modis%Optical_Thickness_Water_Mean)
    352352  if (cfg%Ltauimodis) CALL histwrite2d_cosp(o_tauimodis,modis%Optical_Thickness_Ice_Mean)
    353   if (cfg%Ltautlogmodis) CALL histwrite2d_cosp(o_tautlogmodis,modis%Optical_Thickness_Total_LogMean) 
     353  if (cfg%Ltautlogmodis) CALL histwrite2d_cosp(o_tautlogmodis,modis%Optical_Thickness_Total_LogMean)
    354354  if (cfg%Ltauwlogmodis) CALL histwrite2d_cosp(o_tauwlogmodis,modis%Optical_Thickness_Water_LogMean)
    355355  if (cfg%Ltauilogmodis) CALL histwrite2d_cosp(o_tauilogmodis,modis%Optical_Thickness_Ice_LogMean)
    … …  
    369369       do icl=1,7
    370370         CALL histwrite3d_cosp(o_clmodis, &
    371          modis%Optical_Thickness_vs_Cloud_Top_Pressure(:,icl,:),nvertisccp,icl)           
     371         modis%Optical_Thickness_vs_Cloud_Top_Pressure(:,icl,:),nvertisccp,icl)
    372372       enddo
    373       endif 
     373      endif
    374374   ENDIF
    375375
    … …  
    391391     endif
    392392     if (cfg%Lcrlmodis) then
    393        do icl=1,7 
     393       do icl=1,7
    394394         CALL histwrite3d_cosp(o_crlmodis, &
    395395            modis%Optical_Thickness_vs_ReffLiq(:,icl,:),nvertReffLiq,icl)
    396396       enddo
    397      endif 
     397     endif
    398398   ENDIF
    399399 endif !modis
    … …  
    445445    USE lmdz_print_control, ONLY: lunout,prt_level
    446446    USE wxios
     447    USE lmdz_clesphys
    447448
    448449    IMPLICIT NONE
    449 
    450     INCLUDE "clesphys.h"
    451450
    452451    INTEGER                          :: iff
    … …  
    480479        IF ( var%cles(iff) ) THEN
    481480          if (prt_level >= 10) then
    482             WRITE(lunout,*)'Appel wxios_add_field_to_file var%name =',var%name 
     481            WRITE(lunout,*)'Appel wxios_add_field_to_file var%name =',var%name
    483482          endif
    484483          CALL wxios_add_field_to_file(var%name, 2, cosp_nidfiles(iff), cosp_outfilenames(iff), &
    … …  
    506505    USE lmdz_print_control, ONLY: lunout,prt_level
    507506    USE wxios
     507    USE lmdz_clesphys
    508508
    509509    IMPLICIT NONE
    510 
    511     INCLUDE "clesphys.h"
    512510
    513511    INTEGER                        :: iff, klevs
    … …  
    582580        IF ( var%cles(iff) ) THEN
    583581          if (prt_level >= 10) then
    584               WRITE(lunout,*)'Appel wxios_add_field_to_file 3d nom variable nam_axvert = ',nom, nam_axvert 
     582              WRITE(lunout,*)'Appel wxios_add_field_to_file 3d nom variable nam_axvert = ',nom, nam_axvert
    585583          endif
    586584          CALL wxios_add_field_to_file(nom, 3, cosp_nidfiles(iff), cosp_outfilenames(iff), &
    … …  
    610608  USE lmdz_xios, only: xios_send_field, using_xios
    611609  USE lmdz_abort_physic, ONLY: abort_physic
     610  USE lmdz_clesphys
    612611
    613612  IMPLICIT NONE
    614   INCLUDE 'clesphys.h'
    615613
    616614    TYPE(ctrl_outcosp), INTENT(IN) :: var
    … …  
    643641    !Et sinon on.... écrit
    644642    IF (SIZE(field)/=klon) &
    645   CALL abort_physic('iophy::histwrite2d_cosp','Field first DIMENSION not equal to klon',1) 
     643  CALL abort_physic('iophy::histwrite2d_cosp','Field first DIMENSION not equal to klon',1)
    646644
    647645    CALL Gather_omp(field,buffer_omp)
    … …  
    655653                ALLOCATE(index2d(nbp_lon*jj_nb))
    656654#ifndef CPP_IOIPSL_NO_OUTPUT
    657         CALL histwrite(cosp_nidfiles(iff),var%name,itau_iocosp,Field2d,nbp_lon*jj_nb,index2d) 
     655        CALL histwrite(cosp_nidfiles(iff),var%name,itau_iocosp,Field2d,nbp_lon*jj_nb,index2d)
    658656#endif
    659657            deallocate(index2d)
    … …  
    670668            ENDIF
    671669          ENDIF
    672       ENDDO 
     670      ENDDO
    673671
    674672    IF (using_xios) THEN
    … …  
    681679    ENDIF
    682680
    683 !$OMP END MASTER   
     681!$OMP END MASTER
    684682  ENDIF ! vars_defined
    685683  IF (prt_level >= 9) WRITE(lunout,*)'End histrwrite2d_cosp ',var%name
    … …  
    697695  USE lmdz_xios, only: xios_send_field, using_xios
    698696  USE lmdz_abort_physic, ONLY: abort_physic
     697  USE lmdz_clesphys
    699698
    700699  IMPLICIT NONE
    701   INCLUDE 'clesphys.h'
    702700
    703701    TYPE(ctrl_outcosp), INTENT(IN)    :: var
    … …  
    741739    !Et sinon on.... écrit
    742740    IF (SIZE(field,1)/=klon) &
    743    CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)                                 
     741   CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)
    744742    nlev=SIZE(field,2)
    745743
    … …  
    755753           ALLOCATE(index3d(nbp_lon*jj_nb*nlev))
    756754#ifndef CPP_IOIPSL_NO_OUTPUT
    757     CALL histwrite(cosp_nidfiles(iff),nom,itau_iocosp,Field3d,nbp_lon*jj_nb*nlev,index3d) 
     755    CALL histwrite(cosp_nidfiles(iff),nom,itau_iocosp,Field3d,nbp_lon*jj_nb*nlev,index3d)
    758756#endif
    759757
    … …  
    778776  ENDIF
    779777
    780 !$OMP END MASTER   
     778!$OMP END MASTER
    781779  ENDIF ! vars_defined
    782780  IF (prt_level >= 9) write(lunout,*)'End histrwrite3d_cosp ',nom
    … …  
    794792  USE lmdz_xios, only: xios_send_field, using_xios
    795793  USE lmdz_abort_physic, ONLY: abort_physic
     794  USE lmdz_clesphys
    796795
    797796  IMPLICIT NONE
    798   INCLUDE 'clesphys.h'
    799797
    800798    TYPE(ctrl_outcosp), INTENT(IN)    :: var
    … …  
    814812    !Et sinon on.... écrit
    815813    IF (SIZE(field,1)/=klon) &
    816    CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)           
     814   CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)
    817815
    818816    nlev=SIZE(field,2)
    … …  
    829827   ENDIF
    830828
    831 !$OMP END MASTER   
     829!$OMP END MASTER
    832830  ENDIF ! vars_defined
    833831  IF (prt_level >= 9) write(lunout,*)'End histrwrite4d_cosp ',nom

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_output_write_mod.F90

    r5133 r5154  
    462462    USE lmdz_print_control, ONLY: lunout,prt_level
    463463    USE wxios
     464    USE lmdz_clesphys
    464465
    465466    IMPLICIT NONE
    466 
    467     INCLUDE "clesphys.h"
    468467
    469468    INTEGER                          :: iff
    … …  
    523522    USE lmdz_print_control, ONLY: lunout,prt_level
    524523    USE wxios
     524    USE lmdz_clesphys
    525525
    526526    IMPLICIT NONE
    527 
    528     INCLUDE "clesphys.h"
    529527
    530528    INTEGER                        :: iff, klevs
    … …  
    627625  USE lmdz_xios, only: xios_send_field, using_xios
    628626  USE lmdz_abort_physic, ONLY: abort_physic
     627  USE lmdz_clesphys
    629628
    630629  IMPLICIT NONE
    631   INCLUDE 'clesphys.h'
    632630
    633631    TYPE(ctrl_outcosp), INTENT(IN) :: var
    … …  
    714712  USE lmdz_xios, only: xios_send_field, using_xios
    715713  USE lmdz_abort_physic, ONLY: abort_physic
     714  USE lmdz_clesphys
    716715
    717716  IMPLICIT NONE
    718   INCLUDE 'clesphys.h'
    719717
    720718    TYPE(ctrl_outcosp), INTENT(IN)    :: var
    … …  
    811809  USE lmdz_xios, only: xios_send_field, using_xios
    812810  USE lmdz_abort_physic, ONLY: abort_physic
     811  USE lmdz_clesphys
    813812
    814813  IMPLICIT NONE
    815   INCLUDE 'clesphys.h'
    816814
    817815    TYPE(ctrl_outcosp), INTENT(IN)    :: var

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_output_write_mod.F90

    r5133 r5154  
    657657    USE lmdz_grid_phy, ONLY: nbp_lon
    658658    USE lmdz_print_control, ONLY: lunout,prt_level
    659   USE wxios
     659    USE wxios
     660    USE lmdz_clesphys
    660661
    661662    IMPLICIT NONE
    662 
    663     INCLUDE "clesphys.h"
    664663
    665664    INTEGER                          :: iff
    … …  
    711710    USE lmdz_print_control, ONLY: lunout,prt_level
    712711
    713   USE wxios
     712    USE wxios
     713    USE lmdz_clesphys
    714714
    715715
    716716    IMPLICIT NONE
    717 
    718     INCLUDE "clesphys.h"
    719717
    720718    INTEGER                        :: iff, klevs
    … …  
    809807  USE lmdz_xios, only: xios_send_field
    810808  USE lmdz_abort_physic, ONLY: abort_physic
     809  USE lmdz_clesphys
    811810
    812811  IMPLICIT NONE
    813   INCLUDE 'clesphys.h'
    814812
    815813    TYPE(ctrl_outcosp), INTENT(IN) :: var
    … …  
    892890  USE lmdz_xios, only: xios_send_field
    893891  USE lmdz_abort_physic, ONLY: abort_physic
    894 
     892  USE lmdz_clesphys
    895893
    896894  IMPLICIT NONE
    897   INCLUDE 'clesphys.h'
    898895
    899896    TYPE(ctrl_outcosp), INTENT(IN)    :: var
    … …  
    984981  USE lmdz_xios, only: xios_send_field
    985982  USE lmdz_abort_physic, ONLY: abort_physic
    986 
     983  USE lmdz_clesphys
    987984
    988985  IMPLICIT NONE
    989   INCLUDE 'clesphys.h'
    990986
    991987    TYPE(ctrl_outcosp), INTENT(IN)    :: var

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/readaerosol_optic_ecrad.F90

    r5092 r5154  
    2222  USE infotrac_phy, ONLY: tracers, nqtot, nbtr
    2323  USE YOMCST
     24  USE lmdz_clesphys
    2425
    2526  IMPLICIT NONE
    26 
    27   include "clesphys.h"
    2827
    2928  ! Input arguments

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/lmdz/readaerosol_optic_ecrad.F90

    r4977 r5154  
    2222  USE infotrac_phy, ONLY: tracers, nqtot, nbtr
    2323  USE YOMCST
     24  USE lmdz_clesphys
    2425
    2526  IMPLICIT NONE
    26 
    27   include "clesphys.h"
    2827
    2928  ! Input arguments

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/lmdz/readaerosolstrato_ecrad.F90

    r5133 r5154  
    2525    USE xios
    2626#endif
     27  USE lmdz_clesphys
    2728
    2829    IMPLICIT NONE
    29 
    30     INCLUDE "clesphys.h"
    3130
    3231    CHARACTER (len = 80) :: abort_message

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/aeropt_6bands_rrtm.F90

    r5133 r5154  
    1212  USE YOMCST, ONLY: RG
    1313  USE lmdz_abort_physic, ONLY: abort_physic
     14  USE lmdz_clesphys
    1415
    1516  !    Yves Balkanski le 12 avril 2006
    … …  
    2122  !
    2223  IMPLICIT NONE
    23   !
    24   INCLUDE "clesphys.h"
    25   !
     24  !!
    2625  ! Input arguments:
    2726  !

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/aeropt_lw_rrtm.F90

    r5133 r5154  
    1616  USE YOMCST, ONLY: RG
    1717  USE lmdz_abort_physic, ONLY: abort_physic
     18  USE lmdz_clesphys
    1819
    1920  IMPLICIT NONE
    2021
    21   INCLUDE "clesphys.h"
    2222  !
    2323  ! Input arguments:

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/lwu.F90

    r4389 r5154  
    33!
    44SUBROUTINE LWU &
    5  & ( KIDIA, KFDIA, KLON, KLEV,&
    6  & PAER , PCCO2, PDP , PPMB, PQOF , PTAVE, PVIEW, PWV,&
    7  & PABCU &
    8  & ) 
    9 
    10 !**** *LWU* - LONGWAVE EFFECTIVE ABSORBER AMOUNTS
    11 
    12 !     PURPOSE.
    13 !     --------
    14 !           COMPUTES ABSORBER AMOUNTS INCLUDING PRESSURE AND
    15 !           TEMPERATURE EFFECTS
    16 
    17 !**   INTERFACE.
    18 !     ----------
    19 
    20 !        EXPLICIT ARGUMENTS :
    21 !        --------------------
    22 !     ==== INPUTS ===
    23 ! PAER   : (KLON,6,KLEV)     ; OPTICAL THICKNESS OF THE AEROSOLS
    24 ! PCCO2  :                   ; CONCENTRATION IN CO2 (PA/PA)
    25 ! PDP    : (KLON,KLEV)       ; LAYER PRESSURE THICKNESS (PA)
    26 ! PPMB   : (KLON,KLEV+1)     ; HALF LEVEL PRESSURE
    27 ! PQOF   : (KLON,KLEV)       ; CONCENTRATION IN OZONE (PA/PA)
    28 ! PTAVE  : (KLON,KLEV)       ; TEMPERATURE
    29 ! PWV    : (KLON,KLEV)       ; SPECIFIC HUMIDITY PA/PA
    30 ! PVIEW  : (KLON)            ; COSECANT OF VIEWING ANGLE
    31 !     ==== OUTPUTS ===
    32 ! PABCU  :(KLON,NUA,3*KLEV+1); EFFECTIVE ABSORBER AMOUNTS
    33 
    34 !        IMPLICIT ARGUMENTS :   NONE
    35 !        --------------------
    36 
    37 !     METHOD.
    38 !     -------
    39 
    40 !          1. COMPUTES THE PRESSURE AND TEMPERATURE WEIGHTED AMOUNTS OF
    41 !     ABSORBERS.
    42 
    43 !     EXTERNALS.
    44 !     ----------
    45 
    46 !          NONE
    47 
    48 !     REFERENCE.
    49 !     ----------
    50 
    51 !        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
    52 !        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
    53 
    54 !     AUTHOR.
    55 !     -------
    56 !        JEAN-JACQUES MORCRETTE  *ECMWF*
    57 
    58 !     MODIFICATIONS.
    59 !     --------------
    60 !        ORIGINAL : 89-07-14
    61 !        JJ Morcrette 97-04-18 Revised Continuum + Clean-up
    62 !        M.Hamrud      01-Oct-2003 CY28 Cleaning
    63 
    64 !-----------------------------------------------------------------------
    65 
    66 USE PARKIND1  ,ONLY : JPIM     ,JPRB
    67 USE YOMHOOK   ,ONLY : LHOOK,  DR_HOOK
    68 
    69 USE YOMCST   , ONLY : RG
    70 USE YOESW    , ONLY : RAER
    71 USE YOELW    , ONLY : NSIL     ,NUA      ,NG1      ,NG1P1    ,&
    72  & ALWT     ,BLWT     ,RO3T     ,RT1      ,TREF     ,&
    73  & RVGCO2   ,RVGH2O   ,RVGO3 
    74 !USE YOERDI   , ONLY : RCH4     ,RN2O     ,RCFC11   ,RCFC12
    75 USE YOERDU   , ONLY : R10E     ,REPSCO   ,REPSCQ
     5        & (KIDIA, KFDIA, KLON, KLEV, &
     6        & PAER, PCCO2, PDP, PPMB, PQOF, PTAVE, PVIEW, PWV, &
     7        & PABCU &
     8        &)
     9
     10  !**** *LWU* - LONGWAVE EFFECTIVE ABSORBER AMOUNTS
     11
     12  !     PURPOSE.
     13  !     --------
     14  !           COMPUTES ABSORBER AMOUNTS INCLUDING PRESSURE AND
     15  !           TEMPERATURE EFFECTS
     16
     17  !**   INTERFACE.
     18  !     ----------
     19
     20  !        EXPLICIT ARGUMENTS :
     21  !        --------------------
     22  !     ==== INPUTS ===
     23  ! PAER   : (KLON,6,KLEV)     ; OPTICAL THICKNESS OF THE AEROSOLS
     24  ! PCCO2  :                   ; CONCENTRATION IN CO2 (PA/PA)
     25  ! PDP    : (KLON,KLEV)       ; LAYER PRESSURE THICKNESS (PA)
     26  ! PPMB   : (KLON,KLEV+1)     ; HALF LEVEL PRESSURE
     27  ! PQOF   : (KLON,KLEV)       ; CONCENTRATION IN OZONE (PA/PA)
     28  ! PTAVE  : (KLON,KLEV)       ; TEMPERATURE
     29  ! PWV    : (KLON,KLEV)       ; SPECIFIC HUMIDITY PA/PA
     30  ! PVIEW  : (KLON)            ; COSECANT OF VIEWING ANGLE
     31  !     ==== OUTPUTS ===
     32  ! PABCU  :(KLON,NUA,3*KLEV+1); EFFECTIVE ABSORBER AMOUNTS
     33
     34  !        IMPLICIT ARGUMENTS :   NONE
     35  !        --------------------
     36
     37  !     METHOD.
     38  !     -------
     39
     40  !          1. COMPUTES THE PRESSURE AND TEMPERATURE WEIGHTED AMOUNTS OF
     41  !     ABSORBERS.
     42
     43  !     EXTERNALS.
     44  !     ----------
     45
     46  !          NONE
     47
     48  !     REFERENCE.
     49  !     ----------
     50
     51  !        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
     52  !        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
     53
     54  !     AUTHOR.
     55  !     -------
     56  !        JEAN-JACQUES MORCRETTE  *ECMWF*
     57
     58  !     MODIFICATIONS.
     59  !     --------------
     60  !        ORIGINAL : 89-07-14
     61  !        JJ Morcrette 97-04-18 Revised Continuum + Clean-up
     62  !        M.Hamrud      01-Oct-2003 CY28 Cleaning
     63
     64  !-----------------------------------------------------------------------
     65
     66  USE PARKIND1, ONLY: JPIM, JPRB
     67  USE YOMHOOK, ONLY: LHOOK, DR_HOOK
     68
     69  USE YOMCST, ONLY: RG
     70  USE YOESW, ONLY: RAER
     71  USE YOELW, ONLY: NSIL, NUA, NG1, NG1P1, &
     72          & ALWT, BLWT, RO3T, RT1, TREF, &
     73          & RVGCO2, RVGH2O, RVGO3
     74  !USE YOERDI   , ONLY : RCH4     ,RN2O     ,RCFC11   ,RCFC12
     75  USE YOERDU, ONLY: R10E, REPSCO, REPSCQ
    7676#ifdef REPROBUS
    7777USE chem_rep, ONLY: rch42d, rn2o2d, rcfc112d, rcfc122d, ok_rtime2d
    7878USE infotrac_phy, ONLY : type_trac
    7979#endif
    80 
    81 
    82 IMPLICIT NONE
    83 
    84 INTEGER(KIND=JPIM),INTENT(IN)    :: KLON
    85 INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
    86 INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
    87 INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
    88 REAL(KIND=JPRB)   ,INTENT(IN)    :: PAER(KLON,6,KLEV)
    89 REAL(KIND=JPRB)   ,INTENT(IN)    :: PCCO2
    90 REAL(KIND=JPRB)   ,INTENT(IN)    :: PDP(KLON,KLEV)
    91 REAL(KIND=JPRB)   ,INTENT(IN)    :: PPMB(KLON,KLEV+1)
    92 REAL(KIND=JPRB)   ,INTENT(IN)    :: PQOF(KLON,KLEV)
    93 REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAVE(KLON,KLEV)
    94 REAL(KIND=JPRB)   ,INTENT(IN)    :: PVIEW(KLON)
    95 REAL(KIND=JPRB)   ,INTENT(IN)    :: PWV(KLON,KLEV)
    96 REAL(KIND=JPRB)   ,INTENT(OUT)   :: PABCU(KLON,NUA,3*KLEV+1)
    97 
    98 #include "clesphys.h"
    99 !-----------------------------------------------------------------------
    100 
    101 !*       0.1   ARGUMENTS
    102 !              ---------
    103 
    104 !-----------------------------------------------------------------------
    105 
    106 !              ------------
    107 REAL(KIND=JPRB) :: ZABLY(KLON,7,3*KLEV+1)  , ZDPM(KLON,3*KLEV)&
    108  & ,  ZDUC(KLON, 3*KLEV+1)    , ZFACT(KLON)&
    109  & ,  ZUPM(KLON,3*KLEV) 
    110 REAL(KIND=JPRB) :: ZPHIO(KLON),ZPSC2(KLON) , ZPSC3(KLON), ZPSH1(KLON)&
    111  & ,  ZPSH2(KLON),ZPSH3(KLON) , ZPSH4(KLON), ZPSH5(KLON)&
    112  & ,  ZPSH6(KLON),ZPSIO(KLON) , ZTCON(KLON)&
    113  & ,  ZPHM6(KLON),ZPSM6(KLON) , ZPHN6(KLON), ZPSN6(KLON) 
    114 REAL(KIND=JPRB) :: ZSSIG(KLON,3*KLEV+1)    , ZTAVI(KLON)&
    115  & ,  ZUAER(KLON,NSIL)        , ZXOZ(KLON) , ZXWV(KLON) 
    116 
    117 INTEGER(KIND=JPIM) :: IAE1, IAE2, IAE3, IC, ICP1, IG1, IJ, IJPN,&
    118  & IKIP1, IKJ, IKJP, IKJPN, IKJR, IKL, JA, JAE, &
    119  & JK, JKI, JKK, JL 
    120 
    121 REAL(KIND=JPRB) :: ZALUP, ZCAC8, ZCAH1, ZCAH2, ZCAH3, ZCAH4,&
    122  & ZCAH5, ZCAH6, ZCBC8, ZCBH1, ZCBH2, ZCBH3, &
    123  & ZCBH4, ZCBH5, ZCBH6, ZDIFF, ZDPMG, ZDPMP0, &
    124  & ZFPPW, ZTX, ZTX2, ZU6, ZUP, ZUPMCO2, ZUPMG, &
    125  & ZUPMH2O, ZUPMO3, ZZABLY 
    126 REAL(KIND=JPRB) :: ZHOOK_HANDLE
    127 
    128 
    129 !-----------------------------------------------------------------------
    130 
    131 !*         1.    INITIALIZATION
    132 !                --------------
    133 
    134 !-----------------------------------------------------------------------
    135 
    136 !*         2.    PRESSURE OVER GAUSS SUB-LEVELS
    137 !                ------------------------------
    138 
    139 IF (LHOOK) CALL DR_HOOK('LWU',0,ZHOOK_HANDLE)
    140 DO JL = KIDIA,KFDIA
    141   ZSSIG(JL, 1 ) = PPMB(JL,1) * 100._JPRB
    142 ENDDO
    143 
    144 DO JK = 1 , KLEV
    145   IKJ=(JK-1)*NG1P1+1
    146   IKJR = IKJ
    147   IKJP = IKJ + NG1P1
    148   DO JL = KIDIA,KFDIA
    149     ZSSIG(JL,IKJP)=PPMB(JL,JK+1)* 100._JPRB
    150   ENDDO
    151   DO IG1=1,NG1
    152     IKJ=IKJ+1
    153     DO JL = KIDIA,KFDIA
    154       ZSSIG(JL,IKJ)= (ZSSIG(JL,IKJR) + ZSSIG(JL,IKJP)) * 0.5_JPRB &
    155        & + RT1(IG1) * (ZSSIG(JL,IKJP) - ZSSIG(JL,IKJR)) * 0.5_JPRB 
    156     ENDDO
    157   ENDDO
    158 ENDDO
    159 
    160 !-----------------------------------------------------------------------
    161 
    162 !*         4.    PRESSURE THICKNESS AND MEAN PRESSURE OF SUB-LAYERS
    163 !                --------------------------------------------------
    164 
    165 DO JKI=1,3*KLEV
    166   IKIP1=JKI+1
    167   DO JL = KIDIA,KFDIA
    168     ZUPM(JL,JKI)=(ZSSIG(JL,JKI)+ZSSIG(JL,IKIP1))*0.5_JPRB
    169     ZDPM(JL,JKI)=(ZSSIG(JL,JKI)-ZSSIG(JL,IKIP1))/(10._JPRB*RG)
    170   ENDDO
    171 ENDDO
    172 
    173 DO JK = 1 , KLEV
    174   IKL = KLEV+1 - JK
    175   DO JL = KIDIA,KFDIA
    176     ZXWV(JL) = MAX (PWV(JL,IKL) , REPSCQ )
    177     ZXOZ(JL) = MAX (PQOF(JL,IKL) / PDP(JL,IKL) , REPSCO )
    178   ENDDO
    179   IKJ=(JK-1)*NG1P1+1
    180   IKJPN=IKJ+NG1
    181   DO JKK=IKJ,IKJPN
    182     DO JL = KIDIA,KFDIA
    183       ZDPMG = ZDPM(JL,JKK)
    184       ZDPMP0 = ZDPMG / 101325._JPRB
    185       ZUPMG = ZUPM(JL,JKK) * ZDPMP0
    186       ZUPMCO2 = ( ZUPM(JL,JKK) + RVGCO2 ) * ZDPMP0
    187       ZUPMH2O = ( ZUPM(JL,JKK) + RVGH2O ) * ZDPMP0
    188       ZUPMO3  = ( ZUPM(JL,JKK) + RVGO3  ) * ZDPMP0
    189       ZDUC(JL,JKK) = ZDPMG
    190       ZABLY(JL,6,JKK) = ZXOZ(JL) * ZDPMG
    191       ZABLY(JL,7,JKK) = ZXOZ(JL) * ZUPMO3
    192       ZU6 = ZXWV(JL) * ZUPMG
    193       ZFPPW = 1.6078_JPRB * ZXWV(JL) / (1.0_JPRB+0.608_JPRB*ZXWV(JL))
    194       ZABLY(JL,1,JKK)  = ZXWV(JL) * ZUPMH2O
    195       ZABLY(JL,5,JKK) = ZU6 * ZFPPW
    196       ZABLY(JL,4,JKK) = ZU6 * (1.0_JPRB-ZFPPW)
    197       ZABLY(JL,3,JKK)  = PCCO2 * ZUPMCO2
    198       ZABLY(JL,2,JKK)  = PCCO2 * ZDPMG
    199     ENDDO
    200   ENDDO
    201 ENDDO
    202 
    203 !-----------------------------------------------------------------------
    204 
    205 !*         5.    CUMULATIVE ABSORBER AMOUNTS FROM TOP OF ATMOSPHERE
    206 !                --------------------------------------------------
    207 
    208 DO JA = 1, NUA
    209   DO JL = KIDIA,KFDIA
    210     PABCU(JL,JA,3*KLEV+1) = 0.0_JPRB
    211   ENDDO
    212 ENDDO
    213 
    214 DO JK = 1 , KLEV
    215   IJ=(JK-1)*NG1P1+1
    216   IJPN=IJ+NG1
    217   IKL=KLEV+1-JK
    218 
    219 !*         5.1  CUMULATIVE AEROSOL AMOUNTS FROM TOP OF ATMOSPHERE
    220 !               --------------------------------------------------
    221 ! --            NB: 'PAER' AEROSOLS ARE ENTERED FROM TOP TO BOTTOM
    222 
    223   IAE1=3*KLEV+1-IJ
    224   IAE2=3*KLEV+1-(IJ+1)
    225   IAE3=3*KLEV+1-IJPN
    226 ! print *,'IAE1= ',IAE1
    227 ! print *,'IAE2= ',IAE2
    228 ! print *,'IAE3= ',IAE3
    229 ! print *,'KIDIA= ',KIDIA
    230 ! print *,'KFDIA= ',KFDIA
    231 ! print *,'KLEV= ',KLEV
    232   DO JAE=1,6
    233     DO JL = KIDIA,KFDIA
    234 !   print *,'JL= ',JL,'-JAE= ',JAE,'-JK= ',JK,'-NSIL= ',NSIL
    235       ZUAER(JL,JAE) =&
    236        & (RAER(JAE,1)*PAER(JL,1,JK)+RAER(JAE,2)*PAER(JL,2,JK)&
    237        & +RAER(JAE,3)*PAER(JL,3,JK)+RAER(JAE,4)*PAER(JL,4,JK)&
    238        & +RAER(JAE,5)*PAER(JL,5,JK)+RAER(JAE,6)*PAER(JL,6,JK))&
    239        & /(ZDUC(JL,IAE1)+ZDUC(JL,IAE2)+ZDUC(JL,IAE3)) 
    240     ENDDO
    241   ENDDO
    242 
    243 !*         5.2  INTRODUCES TEMPERATURE EFFECTS ON ABSORBER AMOUNTS
    244 !               --------------------------------------------------
    245 
    246   DO JL = KIDIA,KFDIA
    247     ZTAVI(JL)=PTAVE(JL,IKL)
    248     ZFACT(JL)=1.0_JPRB-ZTAVI(JL)/296._JPRB
    249     ZTCON(JL)=EXP(6.08_JPRB*(296._JPRB/ZTAVI(JL)-1.0_JPRB))
    250 !     ZTCON(JL)=EXP(6.08*ZFACT(JL))
    251     ZTX=ZTAVI(JL)-TREF
    252     ZTX2=ZTX*ZTX
    253     ZZABLY = ZABLY(JL,1,IAE1)+ZABLY(JL,1,IAE2)+ZABLY(JL,1,IAE3)
    254     ZUP=MIN( MAX( 0.5_JPRB*R10E*LOG( ZZABLY ) + 5._JPRB, 0.0_JPRB), 6.0_JPRB)
    255     ZCAH1=ALWT(1,1)+ZUP*(ALWT(1,2)+ZUP*(ALWT(1,3)))
    256     ZCBH1=BLWT(1,1)+ZUP*(BLWT(1,2)+ZUP*(BLWT(1,3)))
    257     ZPSH1(JL)=EXP( ZCAH1 * ZTX + ZCBH1 * ZTX2 )
    258     ZCAH2=ALWT(2,1)+ZUP*(ALWT(2,2)+ZUP*(ALWT(2,3)))
    259     ZCBH2=BLWT(2,1)+ZUP*(BLWT(2,2)+ZUP*(BLWT(2,3)))
    260     ZPSH2(JL)=EXP( ZCAH2 * ZTX + ZCBH2 * ZTX2 )
    261     ZCAH3=ALWT(3,1)+ZUP*(ALWT(3,2)+ZUP*(ALWT(3,3)))
    262     ZCBH3=BLWT(3,1)+ZUP*(BLWT(3,2)+ZUP*(BLWT(3,3)))
    263     ZPSH3(JL)=EXP( ZCAH3 * ZTX + ZCBH3 * ZTX2 )
    264     ZCAH4=ALWT(4,1)+ZUP*(ALWT(4,2)+ZUP*(ALWT(4,3)))
    265     ZCBH4=BLWT(4,1)+ZUP*(BLWT(4,2)+ZUP*(BLWT(4,3)))
    266     ZPSH4(JL)=EXP( ZCAH4 * ZTX + ZCBH4 * ZTX2 )
    267     ZCAH5=ALWT(5,1)+ZUP*(ALWT(5,2)+ZUP*(ALWT(5,3)))
    268     ZCBH5=BLWT(5,1)+ZUP*(BLWT(5,2)+ZUP*(BLWT(5,3)))
    269     ZPSH5(JL)=EXP( ZCAH5 * ZTX + ZCBH5 * ZTX2 )
    270     ZCAH6=ALWT(6,1)+ZUP*(ALWT(6,2)+ZUP*(ALWT(6,3)))
    271     ZCBH6=BLWT(6,1)+ZUP*(BLWT(6,2)+ZUP*(BLWT(6,3)))
    272     ZPSH6(JL)=EXP( ZCAH6 * ZTX + ZCBH6 * ZTX2 )
    273     ZPHM6(JL)=EXP(-5.81E-4_JPRB * ZTX - 1.13E-6_JPRB * ZTX2 )
    274     ZPSM6(JL)=EXP(-5.57E-4_JPRB * ZTX - 3.30E-6_JPRB * ZTX2 )
    275     ZPHN6(JL)=EXP(-3.46E-5_JPRB * ZTX + 2.05E-7_JPRB * ZTX2 )
    276     ZPSN6(JL)=EXP( 3.70E-3_JPRB * ZTX - 2.30E-6_JPRB * ZTX2 )
    277   ENDDO
    278 
    279   DO JL = KIDIA,KFDIA
    280     ZTAVI(JL)=PTAVE(JL,IKL)
    281     ZTX=ZTAVI(JL)-TREF
    282     ZTX2=ZTX*ZTX
    283     ZZABLY = ZABLY(JL,3,IAE1)+ZABLY(JL,3,IAE2)+ZABLY(JL,3,IAE3)
    284     ZALUP = R10E * LOG ( ZZABLY )
    285     ZUP   = MAX( 0.0_JPRB , 5.0_JPRB + 0.5_JPRB * ZALUP )
    286     ZPSC2(JL) = (ZTAVI(JL)/TREF) ** ZUP
    287     ZCAC8=ALWT(8,1)+ZUP*(ALWT(8,2)+ZUP*(ALWT(8,3)))
    288     ZCBC8=BLWT(8,1)+ZUP*(BLWT(8,2)+ZUP*(BLWT(8,3)))
    289     ZPSC3(JL)=EXP( ZCAC8 * ZTX + ZCBC8 * ZTX2 )
    290     ZPHIO(JL) = EXP( RO3T(1) * ZTX + RO3T(2) * ZTX2)
    291     ZPSIO(JL) = EXP( 2.0_JPRB* (RO3T(3)*ZTX+RO3T(4)*ZTX2))
    292   ENDDO
    293 
    294   DO JKK=IJ,IJPN
    295     IC=3*KLEV+1-JKK
    296     ICP1=IC+1
    297     DO JL = KIDIA,KFDIA
    298       ZDIFF = PVIEW(JL)
    299 !- H2O continuum     
    300       PABCU(JL,10,IC)=PABCU(JL,10,ICP1)+ ZABLY(JL,4,IC)          *ZDIFF
    301       PABCU(JL,11,IC)=PABCU(JL,11,ICP1)+ ZABLY(JL,5,IC)*ZTCON(JL)*ZDIFF
    302 !- O3     
    303       PABCU(JL,12,IC)=PABCU(JL,12,ICP1)+ ZABLY(JL,6,IC)*ZPHIO(JL)*ZDIFF
    304       PABCU(JL,13,IC)=PABCU(JL,13,ICP1)+ ZABLY(JL,7,IC)*ZPSIO(JL)*ZDIFF
    305 !- CO2
    306       PABCU(JL,7,IC)=PABCU(JL,7,ICP1)+ ZABLY(JL,3,IC)*ZPSC2(JL)*ZDIFF
    307       PABCU(JL,8,IC)=PABCU(JL,8,ICP1)+ ZABLY(JL,3,IC)*ZPSC3(JL)*ZDIFF
    308       PABCU(JL,9,IC)=PABCU(JL,9,ICP1)+ ZABLY(JL,3,IC)*ZPSC3(JL)*ZDIFF
    309 !- H2O
    310       PABCU(JL,1,IC)=PABCU(JL,1,ICP1)+ ZABLY(JL,1,IC)*ZPSH1(JL)
    311       PABCU(JL,2,IC)=PABCU(JL,2,ICP1)+ ZABLY(JL,1,IC)*ZPSH2(JL)
    312       PABCU(JL,3,IC)=PABCU(JL,3,ICP1)+ ZABLY(JL,1,IC)*ZPSH5(JL)*ZDIFF
    313       PABCU(JL,4,IC)=PABCU(JL,4,ICP1)+ ZABLY(JL,1,IC)*ZPSH3(JL)
    314       PABCU(JL,5,IC)=PABCU(JL,5,ICP1)+ ZABLY(JL,1,IC)*ZPSH4(JL)
    315       PABCU(JL,6,IC)=PABCU(JL,6,ICP1)+ ZABLY(JL,1,IC)*ZPSH6(JL)*ZDIFF
    316 !- aerosols
    317       PABCU(JL,14,IC)=PABCU(JL,14,ICP1)+ ZUAER(JL,1)    *ZDUC(JL,IC)*ZDIFF
    318       PABCU(JL,15,IC)=PABCU(JL,15,ICP1)+ ZUAER(JL,2)    *ZDUC(JL,IC)*ZDIFF
    319       PABCU(JL,16,IC)=PABCU(JL,16,ICP1)+ ZUAER(JL,3)    *ZDUC(JL,IC)*ZDIFF
    320       PABCU(JL,17,IC)=PABCU(JL,17,ICP1)+ ZUAER(JL,4)    *ZDUC(JL,IC)*ZDIFF
    321       PABCU(JL,18,IC)=PABCU(JL,18,ICP1)+ ZUAER(JL,5)    *ZDUC(JL,IC)*ZDIFF
     80  USE lmdz_clesphys
     81
     82  IMPLICIT NONE
     83
     84  INTEGER(KIND = JPIM), INTENT(IN) :: KLON
     85  INTEGER(KIND = JPIM), INTENT(IN) :: KLEV
     86  INTEGER(KIND = JPIM), INTENT(IN) :: KIDIA
     87  INTEGER(KIND = JPIM), INTENT(IN) :: KFDIA
     88  REAL(KIND = JPRB), INTENT(IN) :: PAER(KLON, 6, KLEV)
     89  REAL(KIND = JPRB), INTENT(IN) :: PCCO2
     90  REAL(KIND = JPRB), INTENT(IN) :: PDP(KLON, KLEV)
     91  REAL(KIND = JPRB), INTENT(IN) :: PPMB(KLON, KLEV + 1)
     92  REAL(KIND = JPRB), INTENT(IN) :: PQOF(KLON, KLEV)
     93  REAL(KIND = JPRB), INTENT(IN) :: PTAVE(KLON, KLEV)
     94  REAL(KIND = JPRB), INTENT(IN) :: PVIEW(KLON)
     95  REAL(KIND = JPRB), INTENT(IN) :: PWV(KLON, KLEV)
     96  REAL(KIND = JPRB), INTENT(OUT) :: PABCU(KLON, NUA, 3 * KLEV + 1)
     97
     98  !-----------------------------------------------------------------------
     99
     100  !*       0.1   ARGUMENTS
     101  !              ---------
     102
     103  !-----------------------------------------------------------------------
     104
     105  !              ------------
     106  REAL(KIND = JPRB) :: ZABLY(KLON, 7, 3 * KLEV + 1), ZDPM(KLON, 3 * KLEV)&
     107          &, ZDUC(KLON, 3 * KLEV + 1), ZFACT(KLON)&
     108          &, ZUPM(KLON, 3 * KLEV)
     109  REAL(KIND = JPRB) :: ZPHIO(KLON), ZPSC2(KLON), ZPSC3(KLON), ZPSH1(KLON)&
     110          &, ZPSH2(KLON), ZPSH3(KLON), ZPSH4(KLON), ZPSH5(KLON)&
     111          &, ZPSH6(KLON), ZPSIO(KLON), ZTCON(KLON)&
     112          &, ZPHM6(KLON), ZPSM6(KLON), ZPHN6(KLON), ZPSN6(KLON)
     113  REAL(KIND = JPRB) :: ZSSIG(KLON, 3 * KLEV + 1), ZTAVI(KLON)&
     114          &, ZUAER(KLON, NSIL), ZXOZ(KLON), ZXWV(KLON)
     115
     116  INTEGER(KIND = JPIM) :: IAE1, IAE2, IAE3, IC, ICP1, IG1, IJ, IJPN, &
     117          & IKIP1, IKJ, IKJP, IKJPN, IKJR, IKL, JA, JAE, &
     118          & JK, JKI, JKK, JL
     119
     120  REAL(KIND = JPRB) :: ZALUP, ZCAC8, ZCAH1, ZCAH2, ZCAH3, ZCAH4, &
     121          & ZCAH5, ZCAH6, ZCBC8, ZCBH1, ZCBH2, ZCBH3, &
     122          & ZCBH4, ZCBH5, ZCBH6, ZDIFF, ZDPMG, ZDPMP0, &
     123          & ZFPPW, ZTX, ZTX2, ZU6, ZUP, ZUPMCO2, ZUPMG, &
     124          & ZUPMH2O, ZUPMO3, ZZABLY
     125  REAL(KIND = JPRB) :: ZHOOK_HANDLE
     126
     127
     128  !-----------------------------------------------------------------------
     129
     130  !*         1.    INITIALIZATION
     131  !                --------------
     132
     133  !-----------------------------------------------------------------------
     134
     135  !*         2.    PRESSURE OVER GAUSS SUB-LEVELS
     136  !                ------------------------------
     137
     138  IF (LHOOK) CALL DR_HOOK('LWU', 0, ZHOOK_HANDLE)
     139  DO JL = KIDIA, KFDIA
     140    ZSSIG(JL, 1) = PPMB(JL, 1) * 100._JPRB
     141  ENDDO
     142
     143  DO JK = 1, KLEV
     144    IKJ = (JK - 1) * NG1P1 + 1
     145    IKJR = IKJ
     146    IKJP = IKJ + NG1P1
     147    DO JL = KIDIA, KFDIA
     148      ZSSIG(JL, IKJP) = PPMB(JL, JK + 1) * 100._JPRB
     149    ENDDO
     150    DO IG1 = 1, NG1
     151      IKJ = IKJ + 1
     152      DO JL = KIDIA, KFDIA
     153        ZSSIG(JL, IKJ) = (ZSSIG(JL, IKJR) + ZSSIG(JL, IKJP)) * 0.5_JPRB &
     154                & + RT1(IG1) * (ZSSIG(JL, IKJP) - ZSSIG(JL, IKJR)) * 0.5_JPRB
     155      ENDDO
     156    ENDDO
     157  ENDDO
     158
     159  !-----------------------------------------------------------------------
     160
     161  !*         4.    PRESSURE THICKNESS AND MEAN PRESSURE OF SUB-LAYERS
     162  !                --------------------------------------------------
     163
     164  DO JKI = 1, 3 * KLEV
     165    IKIP1 = JKI + 1
     166    DO JL = KIDIA, KFDIA
     167      ZUPM(JL, JKI) = (ZSSIG(JL, JKI) + ZSSIG(JL, IKIP1)) * 0.5_JPRB
     168      ZDPM(JL, JKI) = (ZSSIG(JL, JKI) - ZSSIG(JL, IKIP1)) / (10._JPRB * RG)
     169    ENDDO
     170  ENDDO
     171
     172  DO JK = 1, KLEV
     173    IKL = KLEV + 1 - JK
     174    DO JL = KIDIA, KFDIA
     175      ZXWV(JL) = MAX (PWV(JL, IKL), REPSCQ)
     176      ZXOZ(JL) = MAX (PQOF(JL, IKL) / PDP(JL, IKL), REPSCO)
     177    ENDDO
     178    IKJ = (JK - 1) * NG1P1 + 1
     179    IKJPN = IKJ + NG1
     180    DO JKK = IKJ, IKJPN
     181      DO JL = KIDIA, KFDIA
     182        ZDPMG = ZDPM(JL, JKK)
     183        ZDPMP0 = ZDPMG / 101325._JPRB
     184        ZUPMG = ZUPM(JL, JKK) * ZDPMP0
     185        ZUPMCO2 = (ZUPM(JL, JKK) + RVGCO2) * ZDPMP0
     186        ZUPMH2O = (ZUPM(JL, JKK) + RVGH2O) * ZDPMP0
     187        ZUPMO3 = (ZUPM(JL, JKK) + RVGO3) * ZDPMP0
     188        ZDUC(JL, JKK) = ZDPMG
     189        ZABLY(JL, 6, JKK) = ZXOZ(JL) * ZDPMG
     190        ZABLY(JL, 7, JKK) = ZXOZ(JL) * ZUPMO3
     191        ZU6 = ZXWV(JL) * ZUPMG
     192        ZFPPW = 1.6078_JPRB * ZXWV(JL) / (1.0_JPRB + 0.608_JPRB * ZXWV(JL))
     193        ZABLY(JL, 1, JKK) = ZXWV(JL) * ZUPMH2O
     194        ZABLY(JL, 5, JKK) = ZU6 * ZFPPW
     195        ZABLY(JL, 4, JKK) = ZU6 * (1.0_JPRB - ZFPPW)
     196        ZABLY(JL, 3, JKK) = PCCO2 * ZUPMCO2
     197        ZABLY(JL, 2, JKK) = PCCO2 * ZDPMG
     198      ENDDO
     199    ENDDO
     200  ENDDO
     201
     202  !-----------------------------------------------------------------------
     203
     204  !*         5.    CUMULATIVE ABSORBER AMOUNTS FROM TOP OF ATMOSPHERE
     205  !                --------------------------------------------------
     206
     207  DO JA = 1, NUA
     208    DO JL = KIDIA, KFDIA
     209      PABCU(JL, JA, 3 * KLEV + 1) = 0.0_JPRB
     210    ENDDO
     211  ENDDO
     212
     213  DO JK = 1, KLEV
     214    IJ = (JK - 1) * NG1P1 + 1
     215    IJPN = IJ + NG1
     216    IKL = KLEV + 1 - JK
     217
     218    !*         5.1  CUMULATIVE AEROSOL AMOUNTS FROM TOP OF ATMOSPHERE
     219    !               --------------------------------------------------
     220    ! --            NB: 'PAER' AEROSOLS ARE ENTERED FROM TOP TO BOTTOM
     221
     222    IAE1 = 3 * KLEV + 1 - IJ
     223    IAE2 = 3 * KLEV + 1 - (IJ + 1)
     224    IAE3 = 3 * KLEV + 1 - IJPN
     225    ! print *,'IAE1= ',IAE1
     226    ! print *,'IAE2= ',IAE2
     227    ! print *,'IAE3= ',IAE3
     228    ! print *,'KIDIA= ',KIDIA
     229    ! print *,'KFDIA= ',KFDIA
     230    ! print *,'KLEV= ',KLEV
     231    DO JAE = 1, 6
     232      DO JL = KIDIA, KFDIA
     233        !   print *,'JL= ',JL,'-JAE= ',JAE,'-JK= ',JK,'-NSIL= ',NSIL
     234        ZUAER(JL, JAE) = &
     235                & (RAER(JAE, 1) * PAER(JL, 1, JK) + RAER(JAE, 2) * PAER(JL, 2, JK)&
     236                & + RAER(JAE, 3) * PAER(JL, 3, JK) + RAER(JAE, 4) * PAER(JL, 4, JK)&
     237                & + RAER(JAE, 5) * PAER(JL, 5, JK) + RAER(JAE, 6) * PAER(JL, 6, JK))&
     238                & / (ZDUC(JL, IAE1) + ZDUC(JL, IAE2) + ZDUC(JL, IAE3))
     239      ENDDO
     240    ENDDO
     241
     242    !*         5.2  INTRODUCES TEMPERATURE EFFECTS ON ABSORBER AMOUNTS
     243    !               --------------------------------------------------
     244
     245    DO JL = KIDIA, KFDIA
     246      ZTAVI(JL) = PTAVE(JL, IKL)
     247      ZFACT(JL) = 1.0_JPRB - ZTAVI(JL) / 296._JPRB
     248      ZTCON(JL) = EXP(6.08_JPRB * (296._JPRB / ZTAVI(JL) - 1.0_JPRB))
     249      !     ZTCON(JL)=EXP(6.08*ZFACT(JL))
     250      ZTX = ZTAVI(JL) - TREF
     251      ZTX2 = ZTX * ZTX
     252      ZZABLY = ZABLY(JL, 1, IAE1) + ZABLY(JL, 1, IAE2) + ZABLY(JL, 1, IAE3)
     253      ZUP = MIN(MAX(0.5_JPRB * R10E * LOG(ZZABLY) + 5._JPRB, 0.0_JPRB), 6.0_JPRB)
     254      ZCAH1 = ALWT(1, 1) + ZUP * (ALWT(1, 2) + ZUP * (ALWT(1, 3)))
     255      ZCBH1 = BLWT(1, 1) + ZUP * (BLWT(1, 2) + ZUP * (BLWT(1, 3)))
     256      ZPSH1(JL) = EXP(ZCAH1 * ZTX + ZCBH1 * ZTX2)
     257      ZCAH2 = ALWT(2, 1) + ZUP * (ALWT(2, 2) + ZUP * (ALWT(2, 3)))
     258      ZCBH2 = BLWT(2, 1) + ZUP * (BLWT(2, 2) + ZUP * (BLWT(2, 3)))
     259      ZPSH2(JL) = EXP(ZCAH2 * ZTX + ZCBH2 * ZTX2)
     260      ZCAH3 = ALWT(3, 1) + ZUP * (ALWT(3, 2) + ZUP * (ALWT(3, 3)))
     261      ZCBH3 = BLWT(3, 1) + ZUP * (BLWT(3, 2) + ZUP * (BLWT(3, 3)))
     262      ZPSH3(JL) = EXP(ZCAH3 * ZTX + ZCBH3 * ZTX2)
     263      ZCAH4 = ALWT(4, 1) + ZUP * (ALWT(4, 2) + ZUP * (ALWT(4, 3)))
     264      ZCBH4 = BLWT(4, 1) + ZUP * (BLWT(4, 2) + ZUP * (BLWT(4, 3)))
     265      ZPSH4(JL) = EXP(ZCAH4 * ZTX + ZCBH4 * ZTX2)
     266      ZCAH5 = ALWT(5, 1) + ZUP * (ALWT(5, 2) + ZUP * (ALWT(5, 3)))
     267      ZCBH5 = BLWT(5, 1) + ZUP * (BLWT(5, 2) + ZUP * (BLWT(5, 3)))
     268      ZPSH5(JL) = EXP(ZCAH5 * ZTX + ZCBH5 * ZTX2)
     269      ZCAH6 = ALWT(6, 1) + ZUP * (ALWT(6, 2) + ZUP * (ALWT(6, 3)))
     270      ZCBH6 = BLWT(6, 1) + ZUP * (BLWT(6, 2) + ZUP * (BLWT(6, 3)))
     271      ZPSH6(JL) = EXP(ZCAH6 * ZTX + ZCBH6 * ZTX2)
     272      ZPHM6(JL) = EXP(-5.81E-4_JPRB * ZTX - 1.13E-6_JPRB * ZTX2)
     273      ZPSM6(JL) = EXP(-5.57E-4_JPRB * ZTX - 3.30E-6_JPRB * ZTX2)
     274      ZPHN6(JL) = EXP(-3.46E-5_JPRB * ZTX + 2.05E-7_JPRB * ZTX2)
     275      ZPSN6(JL) = EXP(3.70E-3_JPRB * ZTX - 2.30E-6_JPRB * ZTX2)
     276    ENDDO
     277
     278    DO JL = KIDIA, KFDIA
     279      ZTAVI(JL) = PTAVE(JL, IKL)
     280      ZTX = ZTAVI(JL) - TREF
     281      ZTX2 = ZTX * ZTX
     282      ZZABLY = ZABLY(JL, 3, IAE1) + ZABLY(JL, 3, IAE2) + ZABLY(JL, 3, IAE3)
     283      ZALUP = R10E * LOG (ZZABLY)
     284      ZUP = MAX(0.0_JPRB, 5.0_JPRB + 0.5_JPRB * ZALUP)
     285      ZPSC2(JL) = (ZTAVI(JL) / TREF) ** ZUP
     286      ZCAC8 = ALWT(8, 1) + ZUP * (ALWT(8, 2) + ZUP * (ALWT(8, 3)))
     287      ZCBC8 = BLWT(8, 1) + ZUP * (BLWT(8, 2) + ZUP * (BLWT(8, 3)))
     288      ZPSC3(JL) = EXP(ZCAC8 * ZTX + ZCBC8 * ZTX2)
     289      ZPHIO(JL) = EXP(RO3T(1) * ZTX + RO3T(2) * ZTX2)
     290      ZPSIO(JL) = EXP(2.0_JPRB * (RO3T(3) * ZTX + RO3T(4) * ZTX2))
     291    ENDDO
     292
     293    DO JKK = IJ, IJPN
     294      IC = 3 * KLEV + 1 - JKK
     295      ICP1 = IC + 1
     296      DO JL = KIDIA, KFDIA
     297        ZDIFF = PVIEW(JL)
     298        !- H2O continuum
     299        PABCU(JL, 10, IC) = PABCU(JL, 10, ICP1) + ZABLY(JL, 4, IC) * ZDIFF
     300        PABCU(JL, 11, IC) = PABCU(JL, 11, ICP1) + ZABLY(JL, 5, IC) * ZTCON(JL) * ZDIFF
     301        !- O3
     302        PABCU(JL, 12, IC) = PABCU(JL, 12, ICP1) + ZABLY(JL, 6, IC) * ZPHIO(JL) * ZDIFF
     303        PABCU(JL, 13, IC) = PABCU(JL, 13, ICP1) + ZABLY(JL, 7, IC) * ZPSIO(JL) * ZDIFF
     304        !- CO2
     305        PABCU(JL, 7, IC) = PABCU(JL, 7, ICP1) + ZABLY(JL, 3, IC) * ZPSC2(JL) * ZDIFF
     306        PABCU(JL, 8, IC) = PABCU(JL, 8, ICP1) + ZABLY(JL, 3, IC) * ZPSC3(JL) * ZDIFF
     307        PABCU(JL, 9, IC) = PABCU(JL, 9, ICP1) + ZABLY(JL, 3, IC) * ZPSC3(JL) * ZDIFF
     308        !- H2O
     309        PABCU(JL, 1, IC) = PABCU(JL, 1, ICP1) + ZABLY(JL, 1, IC) * ZPSH1(JL)
     310        PABCU(JL, 2, IC) = PABCU(JL, 2, ICP1) + ZABLY(JL, 1, IC) * ZPSH2(JL)
     311        PABCU(JL, 3, IC) = PABCU(JL, 3, ICP1) + ZABLY(JL, 1, IC) * ZPSH5(JL) * ZDIFF
     312        PABCU(JL, 4, IC) = PABCU(JL, 4, ICP1) + ZABLY(JL, 1, IC) * ZPSH3(JL)
     313        PABCU(JL, 5, IC) = PABCU(JL, 5, ICP1) + ZABLY(JL, 1, IC) * ZPSH4(JL)
     314        PABCU(JL, 6, IC) = PABCU(JL, 6, ICP1) + ZABLY(JL, 1, IC) * ZPSH6(JL) * ZDIFF
     315        !- aerosols
     316        PABCU(JL, 14, IC) = PABCU(JL, 14, ICP1) + ZUAER(JL, 1) * ZDUC(JL, IC) * ZDIFF
     317        PABCU(JL, 15, IC) = PABCU(JL, 15, ICP1) + ZUAER(JL, 2) * ZDUC(JL, IC) * ZDIFF
     318        PABCU(JL, 16, IC) = PABCU(JL, 16, ICP1) + ZUAER(JL, 3) * ZDUC(JL, IC) * ZDIFF
     319        PABCU(JL, 17, IC) = PABCU(JL, 17, ICP1) + ZUAER(JL, 4) * ZDUC(JL, IC) * ZDIFF
     320        PABCU(JL, 18, IC) = PABCU(JL, 18, ICP1) + ZUAER(JL, 5) * ZDUC(JL, IC) * ZDIFF
    322321#ifdef REPROBUS
    323322        IF (type_trac=='repr'.and. ok_rtime2d) THEN
    … …  
    341340         ELSE
    342341#endif
    343 !- CH4
    344       PABCU(JL,19,IC)=PABCU(JL,19,ICP1)&
    345        & + ZABLY(JL,2,IC)*RCH4/PCCO2*ZPHM6(JL)*ZDIFF 
    346       PABCU(JL,20,IC)=PABCU(JL,20,ICP1)&
    347        & + ZABLY(JL,3,IC)*RCH4/PCCO2*ZPSM6(JL)*ZDIFF 
    348 !- N2O
    349       PABCU(JL,21,IC)=PABCU(JL,21,ICP1)&
    350        & + ZABLY(JL,2,IC)*RN2O/PCCO2*ZPHN6(JL)*ZDIFF 
    351       PABCU(JL,22,IC)=PABCU(JL,22,ICP1)&
    352        & + ZABLY(JL,3,IC)*RN2O/PCCO2*ZPSN6(JL)*ZDIFF 
    353 !- CFC11
    354       PABCU(JL,23,IC)=PABCU(JL,23,ICP1)&
    355        & + ZABLY(JL,2,IC)*RCFC11/PCCO2        *ZDIFF 
    356 !- CFC12
    357       PABCU(JL,24,IC)=PABCU(JL,24,ICP1)&
    358        & + ZABLY(JL,2,IC)*RCFC12/PCCO2        *ZDIFF 
     342        !- CH4
     343        PABCU(JL, 19, IC) = PABCU(JL, 19, ICP1)&
     344                & + ZABLY(JL, 2, IC) * RCH4 / PCCO2 * ZPHM6(JL) * ZDIFF
     345        PABCU(JL, 20, IC) = PABCU(JL, 20, ICP1)&
     346                & + ZABLY(JL, 3, IC) * RCH4 / PCCO2 * ZPSM6(JL) * ZDIFF
     347        !- N2O
     348        PABCU(JL, 21, IC) = PABCU(JL, 21, ICP1)&
     349                & + ZABLY(JL, 2, IC) * RN2O / PCCO2 * ZPHN6(JL) * ZDIFF
     350        PABCU(JL, 22, IC) = PABCU(JL, 22, ICP1)&
     351                & + ZABLY(JL, 3, IC) * RN2O / PCCO2 * ZPSN6(JL) * ZDIFF
     352        !- CFC11
     353        PABCU(JL, 23, IC) = PABCU(JL, 23, ICP1)&
     354                & + ZABLY(JL, 2, IC) * RCFC11 / PCCO2 * ZDIFF
     355        !- CFC12
     356        PABCU(JL, 24, IC) = PABCU(JL, 24, ICP1)&
     357                & + ZABLY(JL, 2, IC) * RCFC12 / PCCO2 * ZDIFF
    359358#ifdef REPROBUS
    360359        END IF
    361360#endif
    362     ENDDO
    363   ENDDO
    364 
    365 ENDDO
    366 !      print *,'END OF LWU'
    367 
    368 
    369 
    370 !-----------------------------------------------------------------------
    371 
    372 IF (LHOOK) CALL DR_HOOK('LWU',1,ZHOOK_HANDLE)
     361      ENDDO
     362    ENDDO
     363
     364  ENDDO
     365  !      print *,'END OF LWU'
     366
     367
     368
     369  !-----------------------------------------------------------------------
     370
     371  IF (LHOOK) CALL DR_HOOK('LWU', 1, ZHOOK_HANDLE)
    373372END SUBROUTINE LWU

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/radlsw.F90

    r5133 r5154  
    152152USE YOMLUN_IFSAUX , ONLY : NULOUT
    153153USE YOMCT3        , ONLY : NSTEP
     154USE lmdz_clesphys
     155USE lmdz_yoethf
    154156
    155157IMPLICIT NONE
    156158
    157 include "clesphys.h"
    158159!!include "clesrrtm.h"
    159 include "YOETHF.h"
    160160INTEGER(KIND=JPIM),INTENT(IN)    :: KLON
    161161INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/radlsw.intfb.h

    r2146 r5154  
    2020 & NRADIP , NRADLP , NICEOPT, NLIQOPT, NINHOM ,NLAYINH ,&
    2121 & RCCNLND, RCCNSEA, RLWINHF, RSWINHF, RRe2De ,&
    22  & LEDBUG
    23 include "clesphys.h"
     22 & LEDBUG
     23 USE lmdz_clesphys
     24
    2425INTEGER(KIND=JPIM),INTENT(IN) :: KLON
    2526INTEGER(KIND=JPIM),INTENT(IN) :: KLEV

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/read_rsun_rrtm.F90

    r5133 r5154  
    1818
    1919  USE YOESW, ONLY : RSUN
     20  USE lmdz_clesphys
    2021
    2122  IMPLICIT NONE
    2223
    23   INCLUDE "clesphys.h"
    2424
    2525  ! Input arguments

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/readaerosol_optic_rrtm.F90

    r5133 r5154  
    2222  USE infotrac_phy, ONLY: tracers, nqtot, nbtr
    2323  USE YOMCST
     24  USE lmdz_clesphys
    2425
    2526  IMPLICIT NONE
    26 
    27   include "clesphys.h"
    2827
    2928  ! Input arguments

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/readaerosolstrato2_rrtm.F90

    r5133 r5154  
    2121    USE lmdz_xios
    2222    USE lmdz_abort_physic, ONLY: abort_physic
     23    USE lmdz_clesphys
    2324
    2425    IMPLICIT NONE
    25 
    26     INCLUDE "clesphys.h"
    2726
    2827    CHARACTER (len = 80) :: abort_message

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/recmwf_aero.F90

    r5133 r5154  
    164164  USE YOMARPHY , ONLY : LRDUST
    165165  USE phys_output_mod, ONLY : swaerofree_diag, swaero_diag
     166  USE lmdz_clesphys
    166167
    167168  !-----------------------------------------------------------------------
    … …  
    171172
    172173  IMPLICIT NONE
    173   INCLUDE "clesphys.h"
    174174
    175175  INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMA

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/rrtm_ecrt_140gp.F90

    r2626 r5154  
    55
    66SUBROUTINE RRTM_ECRT_140GP &
    7  & ( K_IPLON, klon , klev, kcld,&
    8  & paer , paph , pap,&
    9  & pts  , pth  , pt,&
    10  & P_ZEMIS, P_ZEMIW,&
    11  & pq   , pcco2, pozn, pcldf, ptaucld, ptclear,&
    12  & P_CLDFRAC,P_TAUCLD,&
    13  & PTAU_LW,&
    14  & P_COLDRY,P_WKL,P_WX,&
    15  & P_TAUAERL,PAVEL,P_TAVEL,PZ,P_TZ,P_TBOUND,K_NLAYERS,P_SEMISS,K_IREFLECT ) 
    16 
    17 !     Reformatted for F90 by JJMorcrette, ECMWF, 980714
    18 
    19 !     Read in atmospheric profile from ECMWF radiation code, and prepare it
    20 !     for use in RRTM.  Set other RRTM input parameters.  Values are passed
    21 !     back through existing RRTM arrays and commons.
    22 
    23 !- Modifications
    24 
    25 !     2000-05-15 Deborah Salmond  Speed-up
    26 
    27 USE PARKIND1  ,ONLY : JPIM     ,JPRB
    28 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
    29 
    30 USE PARRRTM  , ONLY : JPBAND   ,JPXSEC   ,JPLAY   ,&
    31  & JPINPX 
    32 USE YOERAD   , ONLY : NLW      ,NOVLP
    33 !MPL/IM 20160915 on prend GES de phylmd USE YOERDI   , ONLY :    RCH4     ,RN2O    ,RCFC11  ,RCFC12
    34 USE YOESW    , ONLY : RAER
    35 
    36 !------------------------------Arguments--------------------------------
    37 
    38 IMPLICIT NONE
    39 
    40 
    41 INTEGER(KIND=JPIM),INTENT(IN)    :: KLON! Number of atmospheres (longitudes)
    42 INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV! Number of atmospheric layers
    43 INTEGER(KIND=JPIM),INTENT(IN)    :: K_IPLON
    44 INTEGER(KIND=JPIM),INTENT(OUT)   :: KCLD
    45 REAL(KIND=JPRB)   ,INTENT(IN)    :: PAER(KLON,6,KLEV) ! Aerosol optical thickness
    46 REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPH(KLON,KLEV+1) ! Interface pressures (Pa)
    47 REAL(KIND=JPRB)   ,INTENT(IN)    :: PAP(KLON,KLEV) ! Layer pressures (Pa)
    48 REAL(KIND=JPRB)   ,INTENT(IN)    :: PTS(KLON) ! Surface temperature (K)
    49 REAL(KIND=JPRB)   ,INTENT(IN)    :: PTH(KLON,KLEV+1) ! Interface temperatures (K)
    50 REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KLON,KLEV) ! Layer temperature (K)
    51 REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ZEMIS(KLON) ! Non-window surface emissivity
    52 REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ZEMIW(KLON) ! Window surface emissivity
    53 REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ(KLON,KLEV) ! H2O specific humidity (mmr)
    54 REAL(KIND=JPRB)   ,INTENT(IN)    :: PCCO2 ! CO2 mass mixing ratio
    55 REAL(KIND=JPRB)   ,INTENT(IN)    :: POZN(KLON,KLEV) ! O3 mass mixing ratio
    56 REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLDF(KLON,KLEV) ! Cloud fraction
    57 REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAUCLD(KLON,KLEV,JPBAND) ! Cloud optical depth
    58 !--C.Kleinschmitt
    59 REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAU_LW(KLON,KLEV,NLW) ! LW Optical depth of aerosols 
    60 !--end
    61 REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTCLEAR
    62 REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_CLDFRAC(JPLAY) ! Cloud fraction
    63 REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUCLD(JPLAY,JPBAND) ! Spectral optical thickness
    64 REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_COLDRY(JPLAY)
    65 REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_WKL(JPINPX,JPLAY)
    66 REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_WX(JPXSEC,JPLAY) ! Amount of trace gases
    67 REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUAERL(JPLAY,JPBAND)
    68 REAL(KIND=JPRB)   ,INTENT(OUT)   :: PAVEL(JPLAY)
    69 REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAVEL(JPLAY)
    70 REAL(KIND=JPRB)   ,INTENT(OUT)   :: PZ(0:JPLAY)
    71 REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TZ(0:JPLAY)
    72 REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TBOUND
    73 INTEGER(KIND=JPIM),INTENT(OUT)   :: K_NLAYERS
    74 REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_SEMISS(JPBAND)
    75 INTEGER(KIND=JPIM),INTENT(OUT)   :: K_IREFLECT
    76 !      real rch4                       ! CH4 mass mixing ratio
    77 !      real rn2o                       ! N2O mass mixing ratio
    78 !      real rcfc11                     ! CFC11 mass mixing ratio
    79 !      real rcfc12                     ! CFC12 mass mixing ratio
    80 !- from AER
    81 !- from PROFILE             
    82 !- from SURFACE             
    83 REAL(KIND=JPRB) :: ztauaer(5)
    84 REAL(KIND=JPRB) :: zc1j(0:klev)               ! total cloud from top and level k
    85 REAL(KIND=JPRB) :: Z_AMD                  ! Effective molecular weight of dry air (g/mol)
    86 REAL(KIND=JPRB) :: Z_AMW                  ! Molecular weight of water vapor (g/mol)
    87 REAL(KIND=JPRB) :: Z_AMCO2                ! Molecular weight of carbon dioxide (g/mol)
    88 REAL(KIND=JPRB) :: Z_AMO                  ! Molecular weight of ozone (g/mol)
    89 REAL(KIND=JPRB) :: Z_AMCH4                ! Molecular weight of methane (g/mol)
    90 REAL(KIND=JPRB) :: Z_AMN2O                ! Molecular weight of nitrous oxide (g/mol)
    91 REAL(KIND=JPRB) :: Z_AMC11                ! Molecular weight of CFC11 (g/mol) - CFCL3
    92 REAL(KIND=JPRB) :: Z_AMC12                ! Molecular weight of CFC12 (g/mol) - CF2CL2
    93 REAL(KIND=JPRB) :: Z_AVGDRO               ! Avogadro's number (molecules/mole)
    94 REAL(KIND=JPRB) :: Z_GRAVIT               ! Gravitational acceleration (cm/sec2)
    95 
    96 ! Atomic weights for conversion from mass to volume mixing ratios; these
    97 !  are the same values used in ECRT to assure accurate conversion to vmr
    98 data Z_AMD   /  28.970_JPRB    /
    99 data Z_AMW   /  18.0154_JPRB   /
    100 data Z_AMCO2 /  44.011_JPRB    /
    101 data Z_AMO   /  47.9982_JPRB   /
    102 data Z_AMCH4 /  16.043_JPRB    /
    103 data Z_AMN2O /  44.013_JPRB    /
    104 data Z_AMC11 / 137.3686_JPRB   /
    105 data Z_AMC12 / 120.9140_JPRB   /
    106 data Z_AVGDRO/ 6.02214E23_JPRB /
    107 data Z_GRAVIT/ 9.80665E02_JPRB /
    108 
    109 INTEGER(KIND=JPIM) :: IATM, IMOL, IXMAX, J1, J2, JAE, JB, JK, JL, I_L
    110 INTEGER(KIND=JPIM) :: I_NMOL, I_NXMOL
    111 
    112 REAL(KIND=JPRB) :: Z_AMM, ZCLDLY, ZCLEAR, ZCLOUD, ZEPSEC
    113 REAL(KIND=JPRB) :: ZHOOK_HANDLE
    114 
    115 !MPL/IM 20160915 on prend GES de phylmd
    116 #include "clesphys.h"
    117 ! ***
    118 
    119 ! *** mji
    120 ! Initialize all molecular amounts and aerosol optical depths to zero here,
    121 ! then pass ECRT amounts into RRTM arrays below.
    122 
    123 !      DATA ZWKL /MAXPRDW*0.0/
    124 !      DATA ZWX  /MAXPROD*0.0/
    125 !      DATA KREFLECT /0/
    126 
    127 ! Activate cross section molecules:
    128 !     NXMOL     - number of cross-sections input by user
    129 !     IXINDX(I) - index of cross-section molecule corresponding to Ith
    130 !                 cross-section specified by user
    131 !                 = 0 -- not allowed in RRTM
    132 !                 = 1 -- CCL4
    133 !                 = 2 -- CFC11
    134 !                 = 3 -- CFC12
    135 !                 = 4 -- CFC22
    136 !      DATA KXMOL  /2/
    137 !      DATA KXINDX /0,2,3,0,31*0/
    138 
    139 !      IREFLECT=KREFLECT
    140 !      NXMOL=KXMOL
    141 
    142 IF (LHOOK) CALL DR_HOOK('RRTM_ECRT_140GP',0,ZHOOK_HANDLE)
    143 K_IREFLECT=0
    144 I_NXMOL=2
    145 
    146 DO J1=1,35
    147 ! IXINDX(J1)=0
    148   DO J2=1,KLEV
    149     P_WKL(J1,J2)=0.0_JPRB
    150   ENDDO
    151 ENDDO
    152 !IXINDX(2)=2
    153 !IXINDX(3)=3
    154 
    155 !     Set parameters needed for RRTM execution:
    156 IATM    = 0
    157 !      IXSECT  = 1
    158 !      NUMANGS = 0
    159 !      IOUT    = -1
    160 IXMAX   = 4
    161 
    162 !     Bands 6,7,8 are considered the 'window' and allowed to have a
    163 !     different surface emissivity (as in ECMWF).  Eli wrote this part....
    164 P_SEMISS(1)  = P_ZEMIS(K_IPLON)
    165 P_SEMISS(2)  = P_ZEMIS(K_IPLON)
    166 P_SEMISS(3)  = P_ZEMIS(K_IPLON)
    167 P_SEMISS(4)  = P_ZEMIS(K_IPLON)
    168 P_SEMISS(5)  = P_ZEMIS(K_IPLON)
    169 P_SEMISS(6)  = P_ZEMIW(K_IPLON)
    170 P_SEMISS(7)  = P_ZEMIW(K_IPLON)
    171 P_SEMISS(8)  = P_ZEMIW(K_IPLON)
    172 P_SEMISS(9)  = P_ZEMIS(K_IPLON)
    173 P_SEMISS(10) = P_ZEMIS(K_IPLON)
    174 P_SEMISS(11) = P_ZEMIS(K_IPLON)
    175 P_SEMISS(12) = P_ZEMIS(K_IPLON)
    176 P_SEMISS(13) = P_ZEMIS(K_IPLON)
    177 P_SEMISS(14) = P_ZEMIS(K_IPLON)
    178 P_SEMISS(15) = P_ZEMIS(K_IPLON)
    179 P_SEMISS(16) = P_ZEMIS(K_IPLON)
    180 
    181 !     Set surface temperature. 
    182 
    183 P_TBOUND = pts(K_IPLON)
    184 
    185 !     Install ECRT arrays into RRTM arrays for pressure, temperature,
    186 !     and molecular amounts.  Pressures are converted from Pascals
    187 !     (ECRT) to mb (RRTM).  H2O, CO2, O3 and trace gas amounts are
    188 !     converted from mass mixing ratio to volume mixing ratio.  CO2
    189 !     converted with same dry air and CO2 molecular weights used in
    190 !     ECRT to assure correct conversion back to the proper CO2 vmr.
    191 !     The dry air column COLDRY (in molec/cm2) is calculated from
    192 !     the level pressures PZ (in mb) based on the hydrostatic equation
    193 !     and includes a correction to account for H2O in the layer.  The
    194 !     molecular weight of moist air (amm) is calculated for each layer.
    195 !     Note: RRTM levels count from bottom to top, while the ECRT input
    196 !     variables count from the top down and must be reversed here.
    197 
    198 K_NLAYERS = klev
    199 I_NMOL = 6
    200 PZ(0) = paph(K_IPLON,klev+1)/100._JPRB
    201 P_TZ(0) = pth(K_IPLON,klev+1)
    202 DO I_L = 1, KLEV
    203   PAVEL(I_L) = pap(K_IPLON,KLEV-I_L+1)/100._JPRB
    204   P_TAVEL(I_L) = pt(K_IPLON,KLEV-I_L+1)
    205   PZ(I_L) = paph(K_IPLON,KLEV-I_L+1)/100._JPRB
    206   P_TZ(I_L) = pth(K_IPLON,KLEV-I_L+1)
    207   P_WKL(1,I_L) = pq(K_IPLON,KLEV-I_L+1)*Z_AMD/Z_AMW
    208   P_WKL(2,I_L) = pcco2*Z_AMD/Z_AMCO2
    209   P_WKL(3,I_L) = pozn(K_IPLON,KLEV-I_L+1)*Z_AMD/Z_AMO
    210   P_WKL(4,I_L) = rn2o*Z_AMD/Z_AMN2O
    211   P_WKL(6,I_L) = rch4*Z_AMD/Z_AMCH4
    212   Z_AMM = (1-P_WKL(1,I_L))*Z_AMD + P_WKL(1,I_L)*Z_AMW
    213   P_COLDRY(I_L) = (PZ(I_L-1)-PZ(I_L))*1.E3_JPRB*Z_AVGDRO/(Z_GRAVIT*Z_AMM*(1+P_WKL(1,I_L)))
    214 ENDDO
    215 
    216 !- Fill RRTM aerosol arrays with operational ECMWF aerosols,
    217 !  do the mixing and distribute over the 16 spectral intervals
    218 
    219 DO I_L=1,KLEV
    220   JK=KLEV-I_L+1
    221 !       DO JAE=1,5
    222   JAE=1
    223   ZTAUAER(JAE) =&
    224    & RAER(JAE,1)*PAER(K_IPLON,1,JK)+RAER(JAE,2)*PAER(K_IPLON,2,JK)&
    225    & +RAER(JAE,3)*PAER(K_IPLON,3,JK)+RAER(JAE,4)*PAER(K_IPLON,4,JK)&
    226    & +RAER(JAE,5)*PAER(K_IPLON,5,JK)+RAER(JAE,6)*PAER(K_IPLON,6,JK) 
    227   P_TAUAERL(I_L, 1)=ZTAUAER(1)
    228   P_TAUAERL(I_L, 2)=ZTAUAER(1)
    229   JAE=2
    230   ZTAUAER(JAE) =&
    231    & RAER(JAE,1)*PAER(K_IPLON,1,JK)+RAER(JAE,2)*PAER(K_IPLON,2,JK)&
    232    & +RAER(JAE,3)*PAER(K_IPLON,3,JK)+RAER(JAE,4)*PAER(K_IPLON,4,JK)&
    233    & +RAER(JAE,5)*PAER(K_IPLON,5,JK)+RAER(JAE,6)*PAER(K_IPLON,6,JK) 
    234   P_TAUAERL(I_L, 3)=ZTAUAER(2)
    235   P_TAUAERL(I_L, 4)=ZTAUAER(2)
    236   P_TAUAERL(I_L, 5)=ZTAUAER(2)
    237   JAE=3
    238   ZTAUAER(JAE) =&
    239    & RAER(JAE,1)*PAER(K_IPLON,1,JK)+RAER(JAE,2)*PAER(K_IPLON,2,JK)&
    240    & +RAER(JAE,3)*PAER(K_IPLON,3,JK)+RAER(JAE,4)*PAER(K_IPLON,4,JK)&
    241    & +RAER(JAE,5)*PAER(K_IPLON,5,JK)+RAER(JAE,6)*PAER(K_IPLON,6,JK) 
    242   P_TAUAERL(I_L, 6)=ZTAUAER(3)
    243   P_TAUAERL(I_L, 8)=ZTAUAER(3)
    244   P_TAUAERL(I_L, 9)=ZTAUAER(3)
    245   JAE=4
    246   ZTAUAER(JAE) =&
    247    & RAER(JAE,1)*PAER(K_IPLON,1,JK)+RAER(JAE,2)*PAER(K_IPLON,2,JK)&
    248    & +RAER(JAE,3)*PAER(K_IPLON,3,JK)+RAER(JAE,4)*PAER(K_IPLON,4,JK)&
    249    & +RAER(JAE,5)*PAER(K_IPLON,5,JK)+RAER(JAE,6)*PAER(K_IPLON,6,JK) 
    250   P_TAUAERL(I_L, 7)=ZTAUAER(4)
    251   JAE=5
    252   ZTAUAER(JAE) =&
    253    & RAER(JAE,1)*PAER(K_IPLON,1,JK)+RAER(JAE,2)*PAER(K_IPLON,2,JK)&
    254    & +RAER(JAE,3)*PAER(K_IPLON,3,JK)+RAER(JAE,4)*PAER(K_IPLON,4,JK)&
    255    & +RAER(JAE,5)*PAER(K_IPLON,5,JK)+RAER(JAE,6)*PAER(K_IPLON,6,JK) 
    256 !       END DO
    257   P_TAUAERL(I_L,10)=ZTAUAER(5)
    258   P_TAUAERL(I_L,11)=ZTAUAER(5)
    259   P_TAUAERL(I_L,12)=ZTAUAER(5)
    260   P_TAUAERL(I_L,13)=ZTAUAER(5)
    261   P_TAUAERL(I_L,14)=ZTAUAER(5)
    262   P_TAUAERL(I_L,15)=ZTAUAER(5)
    263   P_TAUAERL(I_L,16)=ZTAUAER(5)
    264 ENDDO
    265 !--Use LW AOD from own Mie calculations (C. Kleinschmitt)
    266 DO I_L=1,KLEV
    267   JK=KLEV-I_L+1
    268   DO JAE=1, NLW
    269     P_TAUAERL(I_L,JAE) = MAX( PTAU_LW(K_IPLON, JK, JAE), 1e-30 )
    270   ENDDO
    271 ENDDO
    272 !--end C. Kleinschmitt
    273 
    274 DO J2=1,KLEV
    275   DO J1=1,JPXSEC
    276     P_WX(J1,J2)=0.0_JPRB
    277   ENDDO
    278 ENDDO
    279 
    280 DO I_L = 1, KLEV
    281 !- Set cross section molecule amounts from ECRT; convert to vmr
    282   P_WX(2,I_L) = rcfc11*Z_AMD/Z_AMC11
    283   P_WX(3,I_L) = rcfc12*Z_AMD/Z_AMC12
    284   P_WX(2,I_L) = P_COLDRY(I_L) * P_WX(2,I_L) * 1.E-20_JPRB
    285   P_WX(3,I_L) = P_COLDRY(I_L) * P_WX(3,I_L) * 1.E-20_JPRB
    286 
    287 !- Here, all molecules in WKL and WX are in volume mixing ratio; convert to
    288 !  molec/cm2 based on COLDRY for use in RRTM
    289 
    290   DO IMOL = 1, I_NMOL
    291     P_WKL(IMOL,I_L) = P_COLDRY(I_L) * P_WKL(IMOL,I_L)
    292   ENDDO 
    293  
    294 ! DO IX = 1,JPXSEC
    295 ! IF (IXINDX(IX)  /=  0) THEN
    296 !     WX(IXINDX(IX),L) = COLDRY(L) * WX(IX,L) * 1.E-20_JPRB
    297 ! ENDIF
    298 ! END DO 
    299 
    300 ENDDO
    301 
    302 !- Approximate treatment for various cloud overlaps
    303 ZCLEAR=1.0_JPRB
    304 ZCLOUD=0.0_JPRB
    305 ZC1J(0)=0.0_JPRB
    306 ZEPSEC=1.E-03_JPRB
    307 JL=K_IPLON
    308 
    309 !++MODIFCODE
    310 IF ((NOVLP == 1).OR.(NOVLP ==6).OR.(NOVLP ==8)) THEN
    311 !--MODIFCODE
    312 
    313   DO JK=1,KLEV
    314     IF (pcldf(JL,JK) > ZEPSEC) THEN
    315       ZCLDLY=pcldf(JL,JK)
    316       ZCLEAR=ZCLEAR &
    317        & *(1.0_JPRB-MAX( ZCLDLY , ZCLOUD ))&
    318        & /(1.0_JPRB-MIN( ZCLOUD , 1.0_JPRB-ZEPSEC )) 
    319       ZCLOUD = ZCLDLY
    320       ZC1J(JK)= 1.0_JPRB - ZCLEAR
    321     ELSE
    322       ZCLDLY=0.0_JPRB
    323       ZCLEAR=ZCLEAR &
    324        & *(1.0_JPRB-MAX( ZCLDLY , ZCLOUD ))&
    325        & /(1.0_JPRB-MIN( ZCLOUD , 1.0_JPRB-ZEPSEC )) 
    326       ZCLOUD = ZCLDLY
    327       ZC1J(JK)= 1.0_JPRB - ZCLEAR
    328     ENDIF
    329   ENDDO
    330 
    331 !++MODIFCODE
    332 ELSEIF ((NOVLP == 2).OR.(NOVLP ==7)) THEN
    333 !--MODIFCODE
    334 
    335   DO JK=1,KLEV
    336     IF (pcldf(JL,JK) > ZEPSEC) THEN
    337       ZCLDLY=pcldf(JL,JK)
    338       ZCLOUD = MAX( ZCLDLY , ZCLOUD )
    339       ZC1J(JK) = ZCLOUD
    340     ELSE
    341       ZCLDLY=0.0_JPRB
    342       ZCLOUD = MAX( ZCLDLY , ZCLOUD )
    343       ZC1J(JK) = ZCLOUD
    344     ENDIF
    345   ENDDO
    346 
    347 !++MODIFCODE
    348 ELSEIF ((NOVLP == 3).OR.(NOVLP ==5)) THEN
    349 !--MODIFCODE
    350 
    351   DO JK=1,KLEV
    352     IF (pcldf(JL,JK) > ZEPSEC) THEN
    353       ZCLDLY=pcldf(JL,JK)
    354       ZCLEAR = ZCLEAR * (1.0_JPRB-ZCLDLY)
    355       ZCLOUD = 1.0_JPRB - ZCLEAR
    356       ZC1J(JK) = ZCLOUD
    357     ELSE
    358       ZCLDLY=0.0_JPRB
    359       ZCLEAR = ZCLEAR * (1.0_JPRB-ZCLDLY)
    360       ZCLOUD = 1.0_JPRB - ZCLEAR
    361       ZC1J(JK) = ZCLOUD
    362     ENDIF
    363   ENDDO
    364 
    365 ELSEIF (NOVLP == 4) THEN
    366 
    367 ENDIF
    368 PTCLEAR=1.0_JPRB-ZC1J(KLEV)
    369 
    370 ! Transfer cloud fraction and cloud optical depth to RRTM arrays;
    371 ! invert array index for pcldf to go from bottom to top for RRTM
    372 
    373 !- clear-sky column
    374 IF (PTCLEAR  >  1.0_JPRB-ZEPSEC) THEN
    375   KCLD=0
     7        & (K_IPLON, klon, klev, kcld, &
     8        & paer, paph, pap, &
     9        & pts, pth, pt, &
     10        & P_ZEMIS, P_ZEMIW, &
     11        & pq, pcco2, pozn, pcldf, ptaucld, ptclear, &
     12        & P_CLDFRAC, P_TAUCLD, &
     13        & PTAU_LW, &
     14        & P_COLDRY, P_WKL, P_WX, &
     15        & P_TAUAERL, PAVEL, P_TAVEL, PZ, P_TZ, P_TBOUND, K_NLAYERS, P_SEMISS, K_IREFLECT)
     16
     17  !     Reformatted for F90 by JJMorcrette, ECMWF, 980714
     18
     19  !     Read in atmospheric profile from ECMWF radiation code, and prepare it
     20  !     for use in RRTM.  Set other RRTM input parameters.  Values are passed
     21  !     back through existing RRTM arrays and commons.
     22
     23  !- Modifications
     24
     25  !     2000-05-15 Deborah Salmond  Speed-up
     26
     27  USE PARKIND1, ONLY: JPIM, JPRB
     28  USE YOMHOOK, ONLY: LHOOK, DR_HOOK
     29
     30  USE PARRRTM, ONLY: JPBAND, JPXSEC, JPLAY, &
     31          & JPINPX
     32  USE YOERAD, ONLY: NLW, NOVLP
     33  !MPL/IM 20160915 on prend GES de phylmd USE YOERDI   , ONLY :    RCH4     ,RN2O    ,RCFC11  ,RCFC12
     34  USE YOESW, ONLY: RAER
     35  USE lmdz_clesphys
     36
     37  !------------------------------Arguments--------------------------------
     38
     39  IMPLICIT NONE
     40
     41  INTEGER(KIND = JPIM), INTENT(IN) :: KLON! Number of atmospheres (longitudes)
     42  INTEGER(KIND = JPIM), INTENT(IN) :: KLEV! Number of atmospheric layers
     43  INTEGER(KIND = JPIM), INTENT(IN) :: K_IPLON
     44  INTEGER(KIND = JPIM), INTENT(OUT) :: KCLD
     45  REAL(KIND = JPRB), INTENT(IN) :: PAER(KLON, 6, KLEV) ! Aerosol optical thickness
     46  REAL(KIND = JPRB), INTENT(IN) :: PAPH(KLON, KLEV + 1) ! Interface pressures (Pa)
     47  REAL(KIND = JPRB), INTENT(IN) :: PAP(KLON, KLEV) ! Layer pressures (Pa)
     48  REAL(KIND = JPRB), INTENT(IN) :: PTS(KLON) ! Surface temperature (K)
     49  REAL(KIND = JPRB), INTENT(IN) :: PTH(KLON, KLEV + 1) ! Interface temperatures (K)
     50  REAL(KIND = JPRB), INTENT(IN) :: PT(KLON, KLEV) ! Layer temperature (K)
     51  REAL(KIND = JPRB), INTENT(IN) :: P_ZEMIS(KLON) ! Non-window surface emissivity
     52  REAL(KIND = JPRB), INTENT(IN) :: P_ZEMIW(KLON) ! Window surface emissivity
     53  REAL(KIND = JPRB), INTENT(IN) :: PQ(KLON, KLEV) ! H2O specific humidity (mmr)
     54  REAL(KIND = JPRB), INTENT(IN) :: PCCO2 ! CO2 mass mixing ratio
     55  REAL(KIND = JPRB), INTENT(IN) :: POZN(KLON, KLEV) ! O3 mass mixing ratio
     56  REAL(KIND = JPRB), INTENT(IN) :: PCLDF(KLON, KLEV) ! Cloud fraction
     57  REAL(KIND = JPRB), INTENT(IN) :: PTAUCLD(KLON, KLEV, JPBAND) ! Cloud optical depth
     58  !--C.Kleinschmitt
     59  REAL(KIND = JPRB), INTENT(IN) :: PTAU_LW(KLON, KLEV, NLW) ! LW Optical depth of aerosols
     60  !--end
     61  REAL(KIND = JPRB), INTENT(OUT) :: PTCLEAR
     62  REAL(KIND = JPRB), INTENT(OUT) :: P_CLDFRAC(JPLAY) ! Cloud fraction
     63  REAL(KIND = JPRB), INTENT(OUT) :: P_TAUCLD(JPLAY, JPBAND) ! Spectral optical thickness
     64  REAL(KIND = JPRB), INTENT(OUT) :: P_COLDRY(JPLAY)
     65  REAL(KIND = JPRB), INTENT(OUT) :: P_WKL(JPINPX, JPLAY)
     66  REAL(KIND = JPRB), INTENT(OUT) :: P_WX(JPXSEC, JPLAY) ! Amount of trace gases
     67  REAL(KIND = JPRB), INTENT(OUT) :: P_TAUAERL(JPLAY, JPBAND)
     68  REAL(KIND = JPRB), INTENT(OUT) :: PAVEL(JPLAY)
     69  REAL(KIND = JPRB), INTENT(OUT) :: P_TAVEL(JPLAY)
     70  REAL(KIND = JPRB), INTENT(OUT) :: PZ(0:JPLAY)
     71  REAL(KIND = JPRB), INTENT(OUT) :: P_TZ(0:JPLAY)
     72  REAL(KIND = JPRB), INTENT(OUT) :: P_TBOUND
     73  INTEGER(KIND = JPIM), INTENT(OUT) :: K_NLAYERS
     74  REAL(KIND = JPRB), INTENT(OUT) :: P_SEMISS(JPBAND)
     75  INTEGER(KIND = JPIM), INTENT(OUT) :: K_IREFLECT
     76  !      real rch4                       ! CH4 mass mixing ratio
     77  !      real rn2o                       ! N2O mass mixing ratio
     78  !      real rcfc11                     ! CFC11 mass mixing ratio
     79  !      real rcfc12                     ! CFC12 mass mixing ratio
     80  !- from AER
     81  !- from PROFILE
     82  !- from SURFACE
     83  REAL(KIND = JPRB) :: ztauaer(5)
     84  REAL(KIND = JPRB) :: zc1j(0:klev)               ! total cloud from top and level k
     85  REAL(KIND = JPRB) :: Z_AMD                  ! Effective molecular weight of dry air (g/mol)
     86  REAL(KIND = JPRB) :: Z_AMW                  ! Molecular weight of water vapor (g/mol)
     87  REAL(KIND = JPRB) :: Z_AMCO2                ! Molecular weight of carbon dioxide (g/mol)
     88  REAL(KIND = JPRB) :: Z_AMO                  ! Molecular weight of ozone (g/mol)
     89  REAL(KIND = JPRB) :: Z_AMCH4                ! Molecular weight of methane (g/mol)
     90  REAL(KIND = JPRB) :: Z_AMN2O                ! Molecular weight of nitrous oxide (g/mol)
     91  REAL(KIND = JPRB) :: Z_AMC11                ! Molecular weight of CFC11 (g/mol) - CFCL3
     92  REAL(KIND = JPRB) :: Z_AMC12                ! Molecular weight of CFC12 (g/mol) - CF2CL2
     93  REAL(KIND = JPRB) :: Z_AVGDRO               ! Avogadro's number (molecules/mole)
     94  REAL(KIND = JPRB) :: Z_GRAVIT               ! Gravitational acceleration (cm/sec2)
     95
     96  ! Atomic weights for conversion from mass to volume mixing ratios; these
     97  !  are the same values used in ECRT to assure accurate conversion to vmr
     98  data Z_AMD   /  28.970_JPRB    /
     99  data Z_AMW   /  18.0154_JPRB   /
     100  data Z_AMCO2 /  44.011_JPRB    /
     101  data Z_AMO   /  47.9982_JPRB   /
     102  data Z_AMCH4 /  16.043_JPRB    /
     103  data Z_AMN2O /  44.013_JPRB    /
     104  data Z_AMC11 / 137.3686_JPRB   /
     105  data Z_AMC12 / 120.9140_JPRB   /
     106  data Z_AVGDRO/ 6.02214E23_JPRB /
     107  data Z_GRAVIT/ 9.80665E02_JPRB /
     108
     109  INTEGER(KIND = JPIM) :: IATM, IMOL, IXMAX, J1, J2, JAE, JB, JK, JL, I_L
     110  INTEGER(KIND = JPIM) :: I_NMOL, I_NXMOL
     111
     112  REAL(KIND = JPRB) :: Z_AMM, ZCLDLY, ZCLEAR, ZCLOUD, ZEPSEC
     113  REAL(KIND = JPRB) :: ZHOOK_HANDLE
     114
     115  ! ***
     116
     117  ! *** mji
     118  ! Initialize all molecular amounts and aerosol optical depths to zero here,
     119  ! then pass ECRT amounts into RRTM arrays below.
     120
     121  !      DATA ZWKL /MAXPRDW*0.0/
     122  !      DATA ZWX  /MAXPROD*0.0/
     123  !      DATA KREFLECT /0/
     124
     125  ! Activate cross section molecules:
     126  !     NXMOL     - number of cross-sections input by user
     127  !     IXINDX(I) - index of cross-section molecule corresponding to Ith
     128  !                 cross-section specified by user
     129  !                 = 0 -- not allowed in RRTM
     130  !                 = 1 -- CCL4
     131  !                 = 2 -- CFC11
     132  !                 = 3 -- CFC12
     133  !                 = 4 -- CFC22
     134  !      DATA KXMOL  /2/
     135  !      DATA KXINDX /0,2,3,0,31*0/
     136
     137  !      IREFLECT=KREFLECT
     138  !      NXMOL=KXMOL
     139
     140  IF (LHOOK) CALL DR_HOOK('RRTM_ECRT_140GP', 0, ZHOOK_HANDLE)
     141  K_IREFLECT = 0
     142  I_NXMOL = 2
     143
     144  DO J1 = 1, 35
     145    ! IXINDX(J1)=0
     146    DO J2 = 1, KLEV
     147      P_WKL(J1, J2) = 0.0_JPRB
     148    ENDDO
     149  ENDDO
     150  !IXINDX(2)=2
     151  !IXINDX(3)=3
     152
     153  !     Set parameters needed for RRTM execution:
     154  IATM = 0
     155  !      IXSECT  = 1
     156  !      NUMANGS = 0
     157  !      IOUT    = -1
     158  IXMAX = 4
     159
     160  !     Bands 6,7,8 are considered the 'window' and allowed to have a
     161  !     different surface emissivity (as in ECMWF).  Eli wrote this part....
     162  P_SEMISS(1) = P_ZEMIS(K_IPLON)
     163  P_SEMISS(2) = P_ZEMIS(K_IPLON)
     164  P_SEMISS(3) = P_ZEMIS(K_IPLON)
     165  P_SEMISS(4) = P_ZEMIS(K_IPLON)
     166  P_SEMISS(5) = P_ZEMIS(K_IPLON)
     167  P_SEMISS(6) = P_ZEMIW(K_IPLON)
     168  P_SEMISS(7) = P_ZEMIW(K_IPLON)
     169  P_SEMISS(8) = P_ZEMIW(K_IPLON)
     170  P_SEMISS(9) = P_ZEMIS(K_IPLON)
     171  P_SEMISS(10) = P_ZEMIS(K_IPLON)
     172  P_SEMISS(11) = P_ZEMIS(K_IPLON)
     173  P_SEMISS(12) = P_ZEMIS(K_IPLON)
     174  P_SEMISS(13) = P_ZEMIS(K_IPLON)
     175  P_SEMISS(14) = P_ZEMIS(K_IPLON)
     176  P_SEMISS(15) = P_ZEMIS(K_IPLON)
     177  P_SEMISS(16) = P_ZEMIS(K_IPLON)
     178
     179  !     Set surface temperature.
     180
     181  P_TBOUND = pts(K_IPLON)
     182
     183  !     Install ECRT arrays into RRTM arrays for pressure, temperature,
     184  !     and molecular amounts.  Pressures are converted from Pascals
     185  !     (ECRT) to mb (RRTM).  H2O, CO2, O3 and trace gas amounts are
     186  !     converted from mass mixing ratio to volume mixing ratio.  CO2
     187  !     converted with same dry air and CO2 molecular weights used in
     188  !     ECRT to assure correct conversion back to the proper CO2 vmr.
     189  !     The dry air column COLDRY (in molec/cm2) is calculated from
     190  !     the level pressures PZ (in mb) based on the hydrostatic equation
     191  !     and includes a correction to account for H2O in the layer.  The
     192  !     molecular weight of moist air (amm) is calculated for each layer.
     193  !     Note: RRTM levels count from bottom to top, while the ECRT input
     194  !     variables count from the top down and must be reversed here.
     195
     196  K_NLAYERS = klev
     197  I_NMOL = 6
     198  PZ(0) = paph(K_IPLON, klev + 1) / 100._JPRB
     199  P_TZ(0) = pth(K_IPLON, klev + 1)
    376200  DO I_L = 1, KLEV
    377     P_CLDFRAC(I_L) = 0.0_JPRB
    378   ENDDO
    379   DO JB=1,JPBAND
    380     DO I_L=1,KLEV
    381       P_TAUCLD(I_L,JB) = 0.0_JPRB
    382     ENDDO
    383   ENDDO
    384 
    385 ELSE
    386 
    387 !- cloudy column
    388 !   The diffusivity factor (Savijarvi, 1997) on the cloud optical
    389 !   thickness TAUCLD has already been applied in RADLSW
    390 
    391   KCLD=1
    392   DO I_L=1,KLEV
    393     P_CLDFRAC(I_L) = pcldf(K_IPLON,I_L)
    394   ENDDO
    395   DO JB=1,JPBAND
    396     DO I_L=1,KLEV
    397       P_TAUCLD(I_L,JB) = ptaucld(K_IPLON,I_L,JB)
    398     ENDDO
    399   ENDDO
    400 
    401 ENDIF
    402 
    403 !     ------------------------------------------------------------------
    404  
    405 IF (LHOOK) CALL DR_HOOK('RRTM_ECRT_140GP',1,ZHOOK_HANDLE)
     201    PAVEL(I_L) = pap(K_IPLON, KLEV - I_L + 1) / 100._JPRB
     202    P_TAVEL(I_L) = pt(K_IPLON, KLEV - I_L + 1)
     203    PZ(I_L) = paph(K_IPLON, KLEV - I_L + 1) / 100._JPRB
     204    P_TZ(I_L) = pth(K_IPLON, KLEV - I_L + 1)
     205    P_WKL(1, I_L) = pq(K_IPLON, KLEV - I_L + 1) * Z_AMD / Z_AMW
     206    P_WKL(2, I_L) = pcco2 * Z_AMD / Z_AMCO2
     207    P_WKL(3, I_L) = pozn(K_IPLON, KLEV - I_L + 1) * Z_AMD / Z_AMO
     208    P_WKL(4, I_L) = rn2o * Z_AMD / Z_AMN2O
     209    P_WKL(6, I_L) = rch4 * Z_AMD / Z_AMCH4
     210    Z_AMM = (1 - P_WKL(1, I_L)) * Z_AMD + P_WKL(1, I_L) * Z_AMW
     211    P_COLDRY(I_L) = (PZ(I_L - 1) - PZ(I_L)) * 1.E3_JPRB * Z_AVGDRO / (Z_GRAVIT * Z_AMM * (1 + P_WKL(1, I_L)))
     212  ENDDO
     213
     214  !- Fill RRTM aerosol arrays with operational ECMWF aerosols,
     215  !  do the mixing and distribute over the 16 spectral intervals
     216
     217  DO I_L = 1, KLEV
     218    JK = KLEV - I_L + 1
     219    !       DO JAE=1,5
     220    JAE = 1
     221    ZTAUAER(JAE) = &
     222            & RAER(JAE, 1) * PAER(K_IPLON, 1, JK) + RAER(JAE, 2) * PAER(K_IPLON, 2, JK)&
     223            & + RAER(JAE, 3) * PAER(K_IPLON, 3, JK) + RAER(JAE, 4) * PAER(K_IPLON, 4, JK)&
     224            & + RAER(JAE, 5) * PAER(K_IPLON, 5, JK) + RAER(JAE, 6) * PAER(K_IPLON, 6, JK)
     225    P_TAUAERL(I_L, 1) = ZTAUAER(1)
     226    P_TAUAERL(I_L, 2) = ZTAUAER(1)
     227    JAE = 2
     228    ZTAUAER(JAE) = &
     229            & RAER(JAE, 1) * PAER(K_IPLON, 1, JK) + RAER(JAE, 2) * PAER(K_IPLON, 2, JK)&
     230            & + RAER(JAE, 3) * PAER(K_IPLON, 3, JK) + RAER(JAE, 4) * PAER(K_IPLON, 4, JK)&
     231            & + RAER(JAE, 5) * PAER(K_IPLON, 5, JK) + RAER(JAE, 6) * PAER(K_IPLON, 6, JK)
     232    P_TAUAERL(I_L, 3) = ZTAUAER(2)
     233    P_TAUAERL(I_L, 4) = ZTAUAER(2)
     234    P_TAUAERL(I_L, 5) = ZTAUAER(2)
     235    JAE = 3
     236    ZTAUAER(JAE) = &
     237            & RAER(JAE, 1) * PAER(K_IPLON, 1, JK) + RAER(JAE, 2) * PAER(K_IPLON, 2, JK)&
     238            & + RAER(JAE, 3) * PAER(K_IPLON, 3, JK) + RAER(JAE, 4) * PAER(K_IPLON, 4, JK)&
     239            & + RAER(JAE, 5) * PAER(K_IPLON, 5, JK) + RAER(JAE, 6) * PAER(K_IPLON, 6, JK)
     240    P_TAUAERL(I_L, 6) = ZTAUAER(3)
     241    P_TAUAERL(I_L, 8) = ZTAUAER(3)
     242    P_TAUAERL(I_L, 9) = ZTAUAER(3)
     243    JAE = 4
     244    ZTAUAER(JAE) = &
     245            & RAER(JAE, 1) * PAER(K_IPLON, 1, JK) + RAER(JAE, 2) * PAER(K_IPLON, 2, JK)&
     246            & + RAER(JAE, 3) * PAER(K_IPLON, 3, JK) + RAER(JAE, 4) * PAER(K_IPLON, 4, JK)&
     247            & + RAER(JAE, 5) * PAER(K_IPLON, 5, JK) + RAER(JAE, 6) * PAER(K_IPLON, 6, JK)
     248    P_TAUAERL(I_L, 7) = ZTAUAER(4)
     249    JAE = 5
     250    ZTAUAER(JAE) = &
     251            & RAER(JAE, 1) * PAER(K_IPLON, 1, JK) + RAER(JAE, 2) * PAER(K_IPLON, 2, JK)&
     252            & + RAER(JAE, 3) * PAER(K_IPLON, 3, JK) + RAER(JAE, 4) * PAER(K_IPLON, 4, JK)&
     253            & + RAER(JAE, 5) * PAER(K_IPLON, 5, JK) + RAER(JAE, 6) * PAER(K_IPLON, 6, JK)
     254    !       END DO
     255    P_TAUAERL(I_L, 10) = ZTAUAER(5)
     256    P_TAUAERL(I_L, 11) = ZTAUAER(5)
     257    P_TAUAERL(I_L, 12) = ZTAUAER(5)
     258    P_TAUAERL(I_L, 13) = ZTAUAER(5)
     259    P_TAUAERL(I_L, 14) = ZTAUAER(5)
     260    P_TAUAERL(I_L, 15) = ZTAUAER(5)
     261    P_TAUAERL(I_L, 16) = ZTAUAER(5)
     262  ENDDO
     263  !--Use LW AOD from own Mie calculations (C. Kleinschmitt)
     264  DO I_L = 1, KLEV
     265    JK = KLEV - I_L + 1
     266    DO JAE = 1, NLW
     267      P_TAUAERL(I_L, JAE) = MAX(PTAU_LW(K_IPLON, JK, JAE), 1e-30)
     268    ENDDO
     269  ENDDO
     270  !--end C. Kleinschmitt
     271
     272  DO J2 = 1, KLEV
     273    DO J1 = 1, JPXSEC
     274      P_WX(J1, J2) = 0.0_JPRB
     275    ENDDO
     276  ENDDO
     277
     278  DO I_L = 1, KLEV
     279    !- Set cross section molecule amounts from ECRT; convert to vmr
     280    P_WX(2, I_L) = rcfc11 * Z_AMD / Z_AMC11
     281    P_WX(3, I_L) = rcfc12 * Z_AMD / Z_AMC12
     282    P_WX(2, I_L) = P_COLDRY(I_L) * P_WX(2, I_L) * 1.E-20_JPRB
     283    P_WX(3, I_L) = P_COLDRY(I_L) * P_WX(3, I_L) * 1.E-20_JPRB
     284
     285    !- Here, all molecules in WKL and WX are in volume mixing ratio; convert to
     286    !  molec/cm2 based on COLDRY for use in RRTM
     287
     288    DO IMOL = 1, I_NMOL
     289      P_WKL(IMOL, I_L) = P_COLDRY(I_L) * P_WKL(IMOL, I_L)
     290    ENDDO
     291
     292    ! DO IX = 1,JPXSEC
     293    ! IF (IXINDX(IX)  /=  0) THEN
     294    !     WX(IXINDX(IX),L) = COLDRY(L) * WX(IX,L) * 1.E-20_JPRB
     295    ! ENDIF
     296    ! END DO
     297
     298  ENDDO
     299
     300  !- Approximate treatment for various cloud overlaps
     301  ZCLEAR = 1.0_JPRB
     302  ZCLOUD = 0.0_JPRB
     303  ZC1J(0) = 0.0_JPRB
     304  ZEPSEC = 1.E-03_JPRB
     305  JL = K_IPLON
     306
     307  !++MODIFCODE
     308  IF ((NOVLP == 1).OR.(NOVLP ==6).OR.(NOVLP ==8)) THEN
     309    !--MODIFCODE
     310
     311    DO JK = 1, KLEV
     312      IF (pcldf(JL, JK) > ZEPSEC) THEN
     313        ZCLDLY = pcldf(JL, JK)
     314        ZCLEAR = ZCLEAR &
     315                & * (1.0_JPRB - MAX(ZCLDLY, ZCLOUD))&
     316                & / (1.0_JPRB - MIN(ZCLOUD, 1.0_JPRB - ZEPSEC))
     317        ZCLOUD = ZCLDLY
     318        ZC1J(JK) = 1.0_JPRB - ZCLEAR
     319      ELSE
     320        ZCLDLY = 0.0_JPRB
     321        ZCLEAR = ZCLEAR &
     322                & * (1.0_JPRB - MAX(ZCLDLY, ZCLOUD))&
     323                & / (1.0_JPRB - MIN(ZCLOUD, 1.0_JPRB - ZEPSEC))
     324        ZCLOUD = ZCLDLY
     325        ZC1J(JK) = 1.0_JPRB - ZCLEAR
     326      ENDIF
     327    ENDDO
     328
     329    !++MODIFCODE
     330  ELSEIF ((NOVLP == 2).OR.(NOVLP ==7)) THEN
     331    !--MODIFCODE
     332
     333    DO JK = 1, KLEV
     334      IF (pcldf(JL, JK) > ZEPSEC) THEN
     335        ZCLDLY = pcldf(JL, JK)
     336        ZCLOUD = MAX(ZCLDLY, ZCLOUD)
     337        ZC1J(JK) = ZCLOUD
     338      ELSE
     339        ZCLDLY = 0.0_JPRB
     340        ZCLOUD = MAX(ZCLDLY, ZCLOUD)
     341        ZC1J(JK) = ZCLOUD
     342      ENDIF
     343    ENDDO
     344
     345    !++MODIFCODE
     346  ELSEIF ((NOVLP == 3).OR.(NOVLP ==5)) THEN
     347    !--MODIFCODE
     348
     349    DO JK = 1, KLEV
     350      IF (pcldf(JL, JK) > ZEPSEC) THEN
     351        ZCLDLY = pcldf(JL, JK)
     352        ZCLEAR = ZCLEAR * (1.0_JPRB - ZCLDLY)
     353        ZCLOUD = 1.0_JPRB - ZCLEAR
     354        ZC1J(JK) = ZCLOUD
     355      ELSE
     356        ZCLDLY = 0.0_JPRB
     357        ZCLEAR = ZCLEAR * (1.0_JPRB - ZCLDLY)
     358        ZCLOUD = 1.0_JPRB - ZCLEAR
     359        ZC1J(JK) = ZCLOUD
     360      ENDIF
     361    ENDDO
     362
     363  ELSEIF (NOVLP == 4) THEN
     364
     365  ENDIF
     366  PTCLEAR = 1.0_JPRB - ZC1J(KLEV)
     367
     368  ! Transfer cloud fraction and cloud optical depth to RRTM arrays;
     369  ! invert array index for pcldf to go from bottom to top for RRTM
     370
     371  !- clear-sky column
     372  IF (PTCLEAR  >  1.0_JPRB - ZEPSEC) THEN
     373    KCLD = 0
     374    DO I_L = 1, KLEV
     375      P_CLDFRAC(I_L) = 0.0_JPRB
     376    ENDDO
     377    DO JB = 1, JPBAND
     378      DO I_L = 1, KLEV
     379        P_TAUCLD(I_L, JB) = 0.0_JPRB
     380      ENDDO
     381    ENDDO
     382
     383  ELSE
     384
     385    !- cloudy column
     386    !   The diffusivity factor (Savijarvi, 1997) on the cloud optical
     387    !   thickness TAUCLD has already been applied in RADLSW
     388
     389    KCLD = 1
     390    DO I_L = 1, KLEV
     391      P_CLDFRAC(I_L) = pcldf(K_IPLON, I_L)
     392    ENDDO
     393    DO JB = 1, JPBAND
     394      DO I_L = 1, KLEV
     395        P_TAUCLD(I_L, JB) = ptaucld(K_IPLON, I_L, JB)
     396      ENDDO
     397    ENDDO
     398
     399  ENDIF
     400
     401  !     ------------------------------------------------------------------
     402
     403  IF (LHOOK) CALL DR_HOOK('RRTM_ECRT_140GP', 1, ZHOOK_HANDLE)
    406404END SUBROUTINE RRTM_ECRT_140GP

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/rrtm_rrtm_140gp.intfb.h

    r2146 r5154  
    1212USE YOERAD   ,ONLY : NLW !--C.Kleinschmitt
    1313USE PARRRTM , ONLY : JPBAND ,JPXSEC ,JPGPT ,JPLAY ,&
    14  & JPINPX 
     14 & JPINPX
     15 USE lmdz_clesphys
    1516!-NLW in clesphys now OB
    16 include "clesphys.h"
    1717INTEGER(KIND=JPIM),INTENT(IN) :: KLON
    1818INTEGER(KIND=JPIM),INTENT(IN) :: KLEV

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/srtm_srtm_224gp.F90

    r2027 r5154  
    33!
    44SUBROUTINE SRTM_SRTM_224GP &
    5  & ( KIDIA , KFDIA  , KLON  , KLEV  , KSW , KOVLP ,&
    6  &   PAER  , PALBD  , PALBP , PAPH  , PAP ,&
    7  &   PTS   , PTH    , PT    ,&
    8  &   PQ    , PCCO2  , POZN  , PRMU0 ,&
    9  &   PFRCL , PTAUC  , PASYC , POMGC ,&
    10  &   PALBT , PFSUX  , PFSUC &
    11  & ) 
    12 
    13 !-- interface to RRTM_SW
    14 !     JJMorcrette 030225
    15 
    16 USE PARKIND1  ,ONLY : JPIM     ,JPRB
    17 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
    18 
    19 USE PARSRTM  , ONLY : JPLAY
    20 !USE YOERDI   , ONLY : RCH4   , RN2O   
    21 USE YOERAD   , ONLY : NAER
    22 USE YOESRTAER, ONLY : RSRTAUA, RSRPIZA, RSRASYA
    23 USE YOMPHY3  , ONLY : RII0
    24 USE YOMCST   , ONLY : RI0
    25 
    26 
    27 
    28 IMPLICIT NONE
    29 
    30 #include "clesphys.h"
    31 
    32 !-- Input arguments
    33 
    34 INTEGER(KIND=JPIM),INTENT(IN)    :: KLON
    35 INTEGER(KIND=JPIM)               :: KLEV! UNDETERMINED INTENT
    36 INTEGER(KIND=JPIM)               :: KSW! UNDETERMINED INTENT
    37 INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
    38 INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
    39 INTEGER(KIND=JPIM),INTENT(IN)    :: KOVLP
    40 REAL(KIND=JPRB)   ,INTENT(IN)    :: PAER(KLON,6,KLEV)    ! top to bottom
    41 REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBD(KLON,KSW)
    42 REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBP(KLON,KSW)
    43 REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPH(KLON,KLEV+1)
    44 REAL(KIND=JPRB)   ,INTENT(IN)    :: PAP(KLON,KLEV)
    45 REAL(KIND=JPRB)   ,INTENT(IN)    :: PTS(KLON)
    46 REAL(KIND=JPRB)   ,INTENT(IN)    :: PTH(KLON,KLEV+1)
    47 REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KLON,KLEV)
    48 REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ(KLON,KLEV)
    49 REAL(KIND=JPRB)   ,INTENT(IN)    :: PCCO2
    50 REAL(KIND=JPRB)   ,INTENT(IN)    :: POZN(KLON,KLEV)
    51 REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMU0(KLON)
    52 REAL(KIND=JPRB)   ,INTENT(IN)    :: PFRCL(KLON,KLEV)     ! bottom to top
    53 REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAUC(KLON,KSW,KLEV) ! bottom to top
    54 REAL(KIND=JPRB)   ,INTENT(IN)    :: PASYC(KLON,KSW,KLEV) ! bottom to top
    55 REAL(KIND=JPRB)   ,INTENT(IN)    :: POMGC(KLON,KSW,KLEV) ! bottom to top
    56 REAL(KIND=JPRB)                  :: PALBT(KLON,KSW) ! Argument NOT used
    57 REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSUX(KLON,2,KLEV+1)
    58 REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSUC(KLON,2,KLEV+1)
    59 !INTEGER_M :: KMOL, KCLDATM, KNFLAG, KCEFLAG, KIQFLAG, KSTR 
    60 
    61 !-- Output arguments
    62 
    63 !-----------------------------------------------------------------------
    64 
    65 !-- dummy integers
    66 
    67 INTEGER(KIND=JPIM) :: ICLDATM, INFLAG, ICEFLAG, I_LIQFLAG, I_NMOL, I_NSTR
    68 
    69 INTEGER(KIND=JPIM) :: IK, IMOL, J1, J2, JAE, JL, JK, JSW
    70 
    71 !-- dummy reals
    72 
    73 REAL(KIND=JPRB) :: Z_PZ(0:JPLAY)   , Z_TZ(0:JPLAY)   , Z_PAVEL(JPLAY)  , Z_TAVEL(JPLAY)
    74 REAL(KIND=JPRB) :: Z_COLDRY(JPLAY) , Z_COLMOL(JPLAY) , Z_WKL(35,JPLAY)
    75 REAL(KIND=JPRB) :: Z_CO2MULT(JPLAY), Z_COLCH4(JPLAY) , Z_COLCO2(JPLAY) , Z_COLH2O(JPLAY)
    76 REAL(KIND=JPRB) :: Z_COLN2O(JPLAY) , Z_COLO2(JPLAY)  , Z_COLO3(JPLAY)
    77 REAL(KIND=JPRB) :: Z_FORFAC(JPLAY) , Z_FORFRAC(JPLAY), Z_SELFFAC(JPLAY), Z_SELFFRAC(JPLAY)
    78 REAL(KIND=JPRB) :: Z_FAC00(JPLAY)  , Z_FAC01(JPLAY)  , Z_FAC10(JPLAY)  , Z_FAC11(JPLAY)
    79 REAL(KIND=JPRB) :: Z_TBOUND        , Z_ONEMINUS    , ZRMU0 , ZADJI0
    80 REAL(KIND=JPRB) :: ZALBD(KSW)    , ZALBP(KSW)    , ZFRCL(JPLAY)
    81 REAL(KIND=JPRB) :: ZTAUC(JPLAY,KSW), ZASYC(JPLAY,KSW), ZOMGC(JPLAY,KSW)
    82 REAL(KIND=JPRB) :: ZTAUA(JPLAY,KSW), ZASYA(JPLAY,KSW), ZOMGA(JPLAY,KSW)
    83 
    84 REAL(KIND=JPRB) :: ZBBCD(JPLAY+1), ZBBCU(JPLAY+1), ZBBFD(JPLAY+1), ZBBFU(JPLAY+1)
    85 REAL(KIND=JPRB) :: ZUVCD(JPLAY+1), ZUVCU(JPLAY+1), ZUVFD(JPLAY+1), ZUVFU(JPLAY+1)
    86 REAL(KIND=JPRB) :: ZVSCD(JPLAY+1), ZVSCU(JPLAY+1), ZVSFD(JPLAY+1), ZVSFU(JPLAY+1)
    87 REAL(KIND=JPRB) :: ZNICD(JPLAY+1), ZNICU(JPLAY+1), ZNIFD(JPLAY+1), ZNIFU(JPLAY+1)
    88 
    89 INTEGER(KIND=JPIM) :: I_LAYTROP, I_LAYSWTCH, I_LAYLOW
    90 INTEGER(KIND=JPIM) :: INDFOR(JPLAY), INDSELF(JPLAY)
    91 INTEGER(KIND=JPIM) :: JP(JPLAY), JT(JPLAY), JT1(JPLAY)
    92 
    93 REAL(KIND=JPRB) :: Z_AMD                  ! Effective molecular weight of dry air (g/mol)
    94 REAL(KIND=JPRB) :: Z_AMW                  ! Molecular weight of water vapor (g/mol)
    95 REAL(KIND=JPRB) :: Z_AMCO2                ! Molecular weight of carbon dioxide (g/mol)
    96 REAL(KIND=JPRB) :: Z_AMO                  ! Molecular weight of ozone (g/mol)
    97 REAL(KIND=JPRB) :: Z_AMCH4                ! Molecular weight of methane (g/mol)
    98 REAL(KIND=JPRB) :: Z_AMN2O                ! Molecular weight of nitrous oxide (g/mol)
    99 REAL(KIND=JPRB) :: Z_AMC11                ! Molecular weight of CFC11 (g/mol) - CFCL3
    100 REAL(KIND=JPRB) :: Z_AMC12                ! Molecular weight of CFC12 (g/mol) - CF2CL2
    101 REAL(KIND=JPRB) :: Z_AVGDRO               ! Avogadro's number (molecules/mole)
    102 REAL(KIND=JPRB) :: Z_GRAVIT               ! Gravitational acceleration (cm/sec2)
    103 REAL(KIND=JPRB) :: Z_AMM
    104 
    105 ! Atomic weights for conversion from mass to volume mixing ratios; these
    106 !  are the same values used in ECRT to assure accurate conversion to vmr
    107 data Z_AMD   /  28.970_JPRB    /
    108 data Z_AMW   /  18.0154_JPRB   /
    109 data Z_AMCO2 /  44.011_JPRB    /
    110 data Z_AMO   /  47.9982_JPRB   /
    111 data Z_AMCH4 /  16.043_JPRB    /
    112 data Z_AMN2O /  44.013_JPRB    /
    113 data Z_AMC11 / 137.3686_JPRB   /
    114 data Z_AMC12 / 120.9140_JPRB   /
    115 data Z_AVGDRO/ 6.02214E23_JPRB /
    116 data Z_GRAVIT/ 9.80665E02_JPRB /
    117 
    118 REAL(KIND=JPRB) :: ZCLEAR, ZCLOUD, ZEPSEC, ZTOTCC
    119 
    120 INTEGER(KIND=JPIM) :: IOVLP
    121 REAL(KIND=JPRB) :: ZHOOK_HANDLE
     5        & (KIDIA, KFDIA, KLON, KLEV, KSW, KOVLP, &
     6        &   PAER, PALBD, PALBP, PAPH, PAP, &
     7        &   PTS, PTH, PT, &
     8        &   PQ, PCCO2, POZN, PRMU0, &
     9        &   PFRCL, PTAUC, PASYC, POMGC, &
     10        &   PALBT, PFSUX, PFSUC &
     11        &)
     12
     13  !-- interface to RRTM_SW
     14  !     JJMorcrette 030225
     15
     16  USE PARKIND1, ONLY: JPIM, JPRB
     17  USE YOMHOOK, ONLY: LHOOK, DR_HOOK
     18
     19  USE PARSRTM, ONLY: JPLAY
     20  !USE YOERDI   , ONLY : RCH4   , RN2O
     21  USE YOERAD, ONLY: NAER
     22  USE YOESRTAER, ONLY: RSRTAUA, RSRPIZA, RSRASYA
     23  USE YOMPHY3, ONLY: RII0
     24  USE YOMCST, ONLY: RI0
     25  USE lmdz_clesphys
     26
     27  IMPLICIT NONE
     28
     29  !-- Input arguments
     30
     31  INTEGER(KIND = JPIM), INTENT(IN) :: KLON
     32  INTEGER(KIND = JPIM) :: KLEV! UNDETERMINED INTENT
     33  INTEGER(KIND = JPIM) :: KSW! UNDETERMINED INTENT
     34  INTEGER(KIND = JPIM), INTENT(IN) :: KIDIA
     35  INTEGER(KIND = JPIM), INTENT(IN) :: KFDIA
     36  INTEGER(KIND = JPIM), INTENT(IN) :: KOVLP
     37  REAL(KIND = JPRB), INTENT(IN) :: PAER(KLON, 6, KLEV)    ! top to bottom
     38  REAL(KIND = JPRB), INTENT(IN) :: PALBD(KLON, KSW)
     39  REAL(KIND = JPRB), INTENT(IN) :: PALBP(KLON, KSW)
     40  REAL(KIND = JPRB), INTENT(IN) :: PAPH(KLON, KLEV + 1)
     41  REAL(KIND = JPRB), INTENT(IN) :: PAP(KLON, KLEV)
     42  REAL(KIND = JPRB), INTENT(IN) :: PTS(KLON)
     43  REAL(KIND = JPRB), INTENT(IN) :: PTH(KLON, KLEV + 1)
     44  REAL(KIND = JPRB), INTENT(IN) :: PT(KLON, KLEV)
     45  REAL(KIND = JPRB), INTENT(IN) :: PQ(KLON, KLEV)
     46  REAL(KIND = JPRB), INTENT(IN) :: PCCO2
     47  REAL(KIND = JPRB), INTENT(IN) :: POZN(KLON, KLEV)
     48  REAL(KIND = JPRB), INTENT(IN) :: PRMU0(KLON)
     49  REAL(KIND = JPRB), INTENT(IN) :: PFRCL(KLON, KLEV)     ! bottom to top
     50  REAL(KIND = JPRB), INTENT(IN) :: PTAUC(KLON, KSW, KLEV) ! bottom to top
     51  REAL(KIND = JPRB), INTENT(IN) :: PASYC(KLON, KSW, KLEV) ! bottom to top
     52  REAL(KIND = JPRB), INTENT(IN) :: POMGC(KLON, KSW, KLEV) ! bottom to top
     53  REAL(KIND = JPRB) :: PALBT(KLON, KSW) ! Argument NOT used
     54  REAL(KIND = JPRB), INTENT(OUT) :: PFSUX(KLON, 2, KLEV + 1)
     55  REAL(KIND = JPRB), INTENT(OUT) :: PFSUC(KLON, 2, KLEV + 1)
     56  !INTEGER_M :: KMOL, KCLDATM, KNFLAG, KCEFLAG, KIQFLAG, KSTR
     57
     58  !-- Output arguments
     59
     60  !-----------------------------------------------------------------------
     61
     62  !-- dummy integers
     63
     64  INTEGER(KIND = JPIM) :: ICLDATM, INFLAG, ICEFLAG, I_LIQFLAG, I_NMOL, I_NSTR
     65
     66  INTEGER(KIND = JPIM) :: IK, IMOL, J1, J2, JAE, JL, JK, JSW
     67
     68  !-- dummy reals
     69
     70  REAL(KIND = JPRB) :: Z_PZ(0:JPLAY), Z_TZ(0:JPLAY), Z_PAVEL(JPLAY), Z_TAVEL(JPLAY)
     71  REAL(KIND = JPRB) :: Z_COLDRY(JPLAY), Z_COLMOL(JPLAY), Z_WKL(35, JPLAY)
     72  REAL(KIND = JPRB) :: Z_CO2MULT(JPLAY), Z_COLCH4(JPLAY), Z_COLCO2(JPLAY), Z_COLH2O(JPLAY)
     73  REAL(KIND = JPRB) :: Z_COLN2O(JPLAY), Z_COLO2(JPLAY), Z_COLO3(JPLAY)
     74  REAL(KIND = JPRB) :: Z_FORFAC(JPLAY), Z_FORFRAC(JPLAY), Z_SELFFAC(JPLAY), Z_SELFFRAC(JPLAY)
     75  REAL(KIND = JPRB) :: Z_FAC00(JPLAY), Z_FAC01(JPLAY), Z_FAC10(JPLAY), Z_FAC11(JPLAY)
     76  REAL(KIND = JPRB) :: Z_TBOUND, Z_ONEMINUS, ZRMU0, ZADJI0
     77  REAL(KIND = JPRB) :: ZALBD(KSW), ZALBP(KSW), ZFRCL(JPLAY)
     78  REAL(KIND = JPRB) :: ZTAUC(JPLAY, KSW), ZASYC(JPLAY, KSW), ZOMGC(JPLAY, KSW)
     79  REAL(KIND = JPRB) :: ZTAUA(JPLAY, KSW), ZASYA(JPLAY, KSW), ZOMGA(JPLAY, KSW)
     80
     81  REAL(KIND = JPRB) :: ZBBCD(JPLAY + 1), ZBBCU(JPLAY + 1), ZBBFD(JPLAY + 1), ZBBFU(JPLAY + 1)
     82  REAL(KIND = JPRB) :: ZUVCD(JPLAY + 1), ZUVCU(JPLAY + 1), ZUVFD(JPLAY + 1), ZUVFU(JPLAY + 1)
     83  REAL(KIND = JPRB) :: ZVSCD(JPLAY + 1), ZVSCU(JPLAY + 1), ZVSFD(JPLAY + 1), ZVSFU(JPLAY + 1)
     84  REAL(KIND = JPRB) :: ZNICD(JPLAY + 1), ZNICU(JPLAY + 1), ZNIFD(JPLAY + 1), ZNIFU(JPLAY + 1)
     85
     86  INTEGER(KIND = JPIM) :: I_LAYTROP, I_LAYSWTCH, I_LAYLOW
     87  INTEGER(KIND = JPIM) :: INDFOR(JPLAY), INDSELF(JPLAY)
     88  INTEGER(KIND = JPIM) :: JP(JPLAY), JT(JPLAY), JT1(JPLAY)
     89
     90  REAL(KIND = JPRB) :: Z_AMD                  ! Effective molecular weight of dry air (g/mol)
     91  REAL(KIND = JPRB) :: Z_AMW                  ! Molecular weight of water vapor (g/mol)
     92  REAL(KIND = JPRB) :: Z_AMCO2                ! Molecular weight of carbon dioxide (g/mol)
     93  REAL(KIND = JPRB) :: Z_AMO                  ! Molecular weight of ozone (g/mol)
     94  REAL(KIND = JPRB) :: Z_AMCH4                ! Molecular weight of methane (g/mol)
     95  REAL(KIND = JPRB) :: Z_AMN2O                ! Molecular weight of nitrous oxide (g/mol)
     96  REAL(KIND = JPRB) :: Z_AMC11                ! Molecular weight of CFC11 (g/mol) - CFCL3
     97  REAL(KIND = JPRB) :: Z_AMC12                ! Molecular weight of CFC12 (g/mol) - CF2CL2
     98  REAL(KIND = JPRB) :: Z_AVGDRO               ! Avogadro's number (molecules/mole)
     99  REAL(KIND = JPRB) :: Z_GRAVIT               ! Gravitational acceleration (cm/sec2)
     100  REAL(KIND = JPRB) :: Z_AMM
     101
     102  ! Atomic weights for conversion from mass to volume mixing ratios; these
     103  !  are the same values used in ECRT to assure accurate conversion to vmr
     104  data Z_AMD   /  28.970_JPRB    /
     105  data Z_AMW   /  18.0154_JPRB   /
     106  data Z_AMCO2 /  44.011_JPRB    /
     107  data Z_AMO   /  47.9982_JPRB   /
     108  data Z_AMCH4 /  16.043_JPRB    /
     109  data Z_AMN2O /  44.013_JPRB    /
     110  data Z_AMC11 / 137.3686_JPRB   /
     111  data Z_AMC12 / 120.9140_JPRB   /
     112  data Z_AVGDRO/ 6.02214E23_JPRB /
     113  data Z_GRAVIT/ 9.80665E02_JPRB /
     114
     115  REAL(KIND = JPRB) :: ZCLEAR, ZCLOUD, ZEPSEC, ZTOTCC
     116
     117  INTEGER(KIND = JPIM) :: IOVLP
     118  REAL(KIND = JPRB) :: ZHOOK_HANDLE
    122119
    123120
    … …  
    126123
    127124
    128 !-----------------------------------------------------------------------
    129 !-- calculate information needed ny the radiative transfer routine
    130 
    131 IF (LHOOK) CALL DR_HOOK('SRTM_SRTM_224GP',0,ZHOOK_HANDLE)
    132 ZEPSEC  = 1.E-06_JPRB
    133 Z_ONEMINUS=1.0_JPRB -  ZEPSEC
    134 ZADJI0 = RII0 / RI0
    135 !-- overlap: 1=max-ran, 2=maximum, 3=random
    136 IOVLP=3
    137 
    138 !print *,'Entering srtm_srtm_224gp'
    139 
    140 ICLDATM = 1
    141 INFLAG    = 2
    142 ICEFLAG    = 3
    143 I_LIQFLAG = 1
    144 I_NMOL    = 6
    145 I_NSTR    = 2
    146 
    147 DO JL = KIDIA, KFDIA
    148   ZRMU0=PRMU0(JL)
    149   IF (ZRMU0 > 0.0_JPRB) THEN
    150 
    151 !- coefficients related to the cloud optical properties (original RRTM_SW)
    152 
    153 !  print *,'just before SRTM_CLDPROP'
    154 
    155 !  DO JK=1,KLEV
    156 !    CLDFRAC(JK) = PFRCL (JL,JK)
    157 !    CLDDAT1(JK) = PSCLA1(JL,JK)
    158 !    CLDDAT2(JK) = PSCLA2(JL,JK)
    159 !    CLDDAT3(JK) = PSCLA3(JL,JK)
    160 !    CLDDAT4(JK) = PSCLA4(JL,JK)
    161 !    DO JMOM=0,16
    162 !      CLDDATMOM(JMOM,JK)=PSCLMOM(JL,JMOM,JK)
    163 !    ENDDO
    164 !    print 9101,JK,CLDFRAC(JK),CLDDAT1(JK),CLDDAT2(JK),CLDDAT3(JK)&
    165 !    &,CLDDAT4(JK),(CLDDATMOM(JMOM,JK),JMOM=0,NSTR)
    166     9101 format(1x,'srtm_srtm_224gp Cld :',I3,f7.4,7E12.5)
    167 !  ENDDO
    168 
    169 !  CALL SRTM_CLDPROP &
    170 !    &( KLEV, ICLDATM, INFLAG, ICEFLAG, LIQFLAG, NSTR &
    171 !    &, CLDFRAC, CLDDAT1, CLDDAT2, CLDDAT3, CLDDAT4, CLDDATMOM &
    172 !    &, TAUCLDORIG, TAUCLOUD, SSACLOUD, XMOM &
    173 !    &)
    174 
    175 !- coefficients for the temperature and pressure dependence of the
    176 ! molecular absorption coefficients
    177 
    178     DO J1=1,35
    179       DO J2=1,KLEV
    180         Z_WKL(J1,J2)=0.0_JPRB
    181       ENDDO
    182     ENDDO
    183 
    184     Z_TBOUND=PTS(JL)
    185     Z_PZ(0) = paph(JL,klev+1)/100._JPRB
    186     Z_TZ(0) = pth (JL,klev+1)
    187 
    188     ZCLEAR=1.0_JPRB
    189     ZCLOUD=0.0_JPRB
    190     ZTOTCC=0.0_JPRB
    191     DO JK = 1, KLEV
    192       Z_PAVEL(JK) = pap(JL,KLEV-JK+1) /100._JPRB
    193       Z_TAVEL(JK) = pt (JL,KLEV-JK+1)
    194       Z_PZ(JK)    = paph(JL,KLEV-JK+1)/100._JPRB
    195       Z_TZ(JK)    = pth (JL,KLEV-JK+1)
    196       Z_WKL(1,JK) = pq(JL,KLEV-JK+1)  *Z_AMD/Z_AMW
    197       Z_WKL(2,JK) = pcco2             *Z_AMD/Z_AMCO2
    198       Z_WKL(3,JK) = pozn(JL,KLEV-JK+1)*Z_AMD/Z_AMO
    199       Z_WKL(4,JK) = rn2o              *Z_AMD/Z_AMN2O
    200       Z_WKL(6,JK) = rch4              *Z_AMD/Z_AMCH4
    201       Z_AMM = (1-Z_WKL(1,JK))*Z_AMD + Z_WKL(1,JK)*Z_AMW
    202       Z_COLDRY(JK) = (Z_PZ(JK-1)-Z_PZ(JK))*1.E3_JPRB*Z_AVGDRO/(Z_GRAVIT*Z_AMM*(1+Z_WKL(1,JK)))
    203 !    print 9200,JK,PAVEL(JK),TAVEL(JK),(WKL(JA,JK),JA=1,4),WKL(6,JK),COLDRY(JK)
    204       9200 format(1x,'SRTM ',I3,2F7.1,6E13.5)
    205 
    206       IF (KOVLP == 1) THEN
    207         ZCLEAR=ZCLEAR*(1.0_JPRB-MAX(PFRCL(JL,JK),ZCLOUD)) &
    208          & /(1.0_JPRB-MIN(ZCLOUD,1.0_JPRB-ZEPSEC)) 
    209         ZCLOUD=PFRCL(JL,JK)
    210         ZTOTCC=1.0_JPRB-ZCLEAR
    211       ELSEIF (KOVLP == 2) THEN
    212         ZCLOUD=MAX(ZCLOUD,PFRCL(JL,JK))
    213         ZCLEAR=1.0_JPRB-ZCLOUD
    214         ZTOTCC=ZCLOUD
    215       ELSEIF (KOVLP == 3) THEN
    216         ZCLEAR=ZCLEAR*(1.0_JPRB-PFRCL(JL,JK))
    217         ZCLOUD=1.0_JPRB-ZCLEAR
    218         ZTOTCC=ZCLOUD
     125  !-----------------------------------------------------------------------
     126  !-- calculate information needed ny the radiative transfer routine
     127
     128  IF (LHOOK) CALL DR_HOOK('SRTM_SRTM_224GP', 0, ZHOOK_HANDLE)
     129  ZEPSEC = 1.E-06_JPRB
     130  Z_ONEMINUS = 1.0_JPRB - ZEPSEC
     131  ZADJI0 = RII0 / RI0
     132  !-- overlap: 1=max-ran, 2=maximum, 3=random
     133  IOVLP = 3
     134
     135  !print *,'Entering srtm_srtm_224gp'
     136
     137  ICLDATM = 1
     138  INFLAG = 2
     139  ICEFLAG = 3
     140  I_LIQFLAG = 1
     141  I_NMOL = 6
     142  I_NSTR = 2
     143
     144  DO JL = KIDIA, KFDIA
     145    ZRMU0 = PRMU0(JL)
     146    IF (ZRMU0 > 0.0_JPRB) THEN
     147
     148      !- coefficients related to the cloud optical properties (original RRTM_SW)
     149
     150      !  print *,'just before SRTM_CLDPROP'
     151
     152      !  DO JK=1,KLEV
     153      !    CLDFRAC(JK) = PFRCL (JL,JK)
     154      !    CLDDAT1(JK) = PSCLA1(JL,JK)
     155      !    CLDDAT2(JK) = PSCLA2(JL,JK)
     156      !    CLDDAT3(JK) = PSCLA3(JL,JK)
     157      !    CLDDAT4(JK) = PSCLA4(JL,JK)
     158      !    DO JMOM=0,16
     159      !      CLDDATMOM(JMOM,JK)=PSCLMOM(JL,JMOM,JK)
     160      !    ENDDO
     161      !    print 9101,JK,CLDFRAC(JK),CLDDAT1(JK),CLDDAT2(JK),CLDDAT3(JK)&
     162      !    &,CLDDAT4(JK),(CLDDATMOM(JMOM,JK),JMOM=0,NSTR)
     163      9101 format(1x, 'srtm_srtm_224gp Cld :', I3, f7.4, 7E12.5)
     164      !  ENDDO
     165
     166      !  CALL SRTM_CLDPROP &
     167      !    &( KLEV, ICLDATM, INFLAG, ICEFLAG, LIQFLAG, NSTR &
     168      !    &, CLDFRAC, CLDDAT1, CLDDAT2, CLDDAT3, CLDDAT4, CLDDATMOM &
     169      !    &, TAUCLDORIG, TAUCLOUD, SSACLOUD, XMOM &
     170      !    &)
     171
     172      !- coefficients for the temperature and pressure dependence of the
     173      ! molecular absorption coefficients
     174
     175      DO J1 = 1, 35
     176        DO J2 = 1, KLEV
     177          Z_WKL(J1, J2) = 0.0_JPRB
     178        ENDDO
     179      ENDDO
     180
     181      Z_TBOUND = PTS(JL)
     182      Z_PZ(0) = paph(JL, klev + 1) / 100._JPRB
     183      Z_TZ(0) = pth (JL, klev + 1)
     184
     185      ZCLEAR = 1.0_JPRB
     186      ZCLOUD = 0.0_JPRB
     187      ZTOTCC = 0.0_JPRB
     188      DO JK = 1, KLEV
     189        Z_PAVEL(JK) = pap(JL, KLEV - JK + 1) / 100._JPRB
     190        Z_TAVEL(JK) = pt (JL, KLEV - JK + 1)
     191        Z_PZ(JK) = paph(JL, KLEV - JK + 1) / 100._JPRB
     192        Z_TZ(JK) = pth (JL, KLEV - JK + 1)
     193        Z_WKL(1, JK) = pq(JL, KLEV - JK + 1) * Z_AMD / Z_AMW
     194        Z_WKL(2, JK) = pcco2 * Z_AMD / Z_AMCO2
     195        Z_WKL(3, JK) = pozn(JL, KLEV - JK + 1) * Z_AMD / Z_AMO
     196        Z_WKL(4, JK) = rn2o * Z_AMD / Z_AMN2O
     197        Z_WKL(6, JK) = rch4 * Z_AMD / Z_AMCH4
     198        Z_AMM = (1 - Z_WKL(1, JK)) * Z_AMD + Z_WKL(1, JK) * Z_AMW
     199        Z_COLDRY(JK) = (Z_PZ(JK - 1) - Z_PZ(JK)) * 1.E3_JPRB * Z_AVGDRO / (Z_GRAVIT * Z_AMM * (1 + Z_WKL(1, JK)))
     200        !    print 9200,JK,PAVEL(JK),TAVEL(JK),(WKL(JA,JK),JA=1,4),WKL(6,JK),COLDRY(JK)
     201        9200 format(1x, 'SRTM ', I3, 2F7.1, 6E13.5)
     202
     203        IF (KOVLP == 1) THEN
     204          ZCLEAR = ZCLEAR * (1.0_JPRB - MAX(PFRCL(JL, JK), ZCLOUD)) &
     205                  & / (1.0_JPRB - MIN(ZCLOUD, 1.0_JPRB - ZEPSEC))
     206          ZCLOUD = PFRCL(JL, JK)
     207          ZTOTCC = 1.0_JPRB - ZCLEAR
     208        ELSEIF (KOVLP == 2) THEN
     209          ZCLOUD = MAX(ZCLOUD, PFRCL(JL, JK))
     210          ZCLEAR = 1.0_JPRB - ZCLOUD
     211          ZTOTCC = ZCLOUD
     212        ELSEIF (KOVLP == 3) THEN
     213          ZCLEAR = ZCLEAR * (1.0_JPRB - PFRCL(JL, JK))
     214          ZCLOUD = 1.0_JPRB - ZCLEAR
     215          ZTOTCC = ZCLOUD
     216        ENDIF
     217
     218      ENDDO
     219
     220      !  print *,'ZTOTCC ZCLEAR : ',ZTOTCC,' ',ZCLEAR
     221
     222      DO IMOL = 1, I_NMOL
     223        DO JK = 1, KLEV
     224          Z_WKL(IMOL, JK) = Z_COLDRY(JK) * Z_WKL(IMOL, JK)
     225        ENDDO
     226      ENDDO
     227
     228      !    IF (ZTOTCC == 0.0_JPRB) THEN
     229      !      DO JK=1,KLEV
     230      !        ZFRCL(JK)=0.0_JPRB
     231      !      ENDDO
     232      !    ELSE
     233      !      DO JK=1,KLEV
     234      !        ZFRCL(JK)=PFRCL(JL,JK)/ZTOTCC
     235      !      ENDDO
     236      !    ENDIF
     237
     238      !  print *,'just before SRTM_SETCOEF'
     239
     240      ZFRCL(1:KLEV) = PFRCL(JL, 1:KLEV)
     241      ZCLEAR = 0._JPRB
     242      ZCLOUD = 1._JPRB
     243
     244      CALL SRTM_SETCOEF &
     245              & (KLEV, I_NMOL, &
     246              & Z_PAVEL, Z_TAVEL, Z_PZ, Z_TZ, Z_TBOUND, &
     247              & Z_COLDRY, Z_WKL, &
     248              & I_LAYTROP, I_LAYSWTCH, I_LAYLOW, &
     249              & Z_CO2MULT, Z_COLCH4, Z_COLCO2, Z_COLH2O, Z_COLMOL, Z_COLN2O, Z_COLO2, Z_COLO3, &
     250              & Z_FORFAC, Z_FORFRAC, INDFOR, Z_SELFFAC, Z_SELFFRAC, INDSELF, &
     251              & Z_FAC00, Z_FAC01, Z_FAC10, Z_FAC11, &
     252              & JP, JT, JT1     &
     253              &)
     254
     255      !  print *,'just after SRTM_SETCOEF'
     256
     257      !- call the radiation transfer routine
     258
     259      DO JSW = 1, KSW
     260        ZALBD(JSW) = PALBD(JL, JSW)
     261        ZALBP(JSW) = PALBP(JL, JSW)
     262        DO JK = 1, KLEV
     263          ZTAUC(JK, JSW) = PTAUC(JL, JSW, JK)
     264          ZASYC(JK, JSW) = PASYC(JL, JSW, JK)
     265          ZOMGC(JK, JSW) = POMGC(JL, JSW, JK)
     266          !      print 9002,JSW,JK,ZFRCL(JK),ZTAUC(JK,JSW),ZASYC(JK,JSW),ZOMGC(JK,JSW)
     267          9002  format(1x, 'srtm_224gp ClOPropECmodel ', 2I3, f8.4, 3E12.5)
     268        ENDDO
     269      ENDDO
     270
     271      !- mixing of aerosols
     272
     273      !  print *,'Aerosol optical properties computations'
     274      !  DO JSW=1,KSW
     275      !    print 9012,JSW,(JAE,RSRTAUA(JSW,JAE),RSRPIZA(JSW,JAE),RSRASYA(JSW,JAE),JAE=1,6)
     276      9012 format(I3, (/, I3, 3E13.5))
     277      !  ENDDO
     278
     279      !  DO JK=1,KLEV
     280      !    print 9013,JK,(PAER(JL,JAE,JK),JAE=1,6)
     281      9013 format(1x, I3, 6E12.5)
     282      !  ENDDO
     283
     284      IF (NAER == 0) THEN
     285        DO JSW = 1, KSW
     286          DO JK = 1, KLEV
     287            ZTAUA(JK, JSW) = 0.0_JPRB
     288            ZASYA(JK, JSW) = 0.0_JPRB
     289            ZOMGA(JK, JSW) = 1.0_JPRB
     290          ENDDO
     291        ENDDO
     292      ELSE
     293        DO JSW = 1, KSW
     294          DO JK = 1, KLEV
     295            IK = KLEV + 1 - JK
     296            ZTAUA(JK, JSW) = 0.0_JPRB
     297            ZASYA(JK, JSW) = 0.0_JPRB
     298            ZOMGA(JK, JSW) = 0.0_JPRB
     299            DO JAE = 1, 6
     300              ZTAUA(JK, JSW) = ZTAUA(JK, JSW) + RSRTAUA(JSW, JAE) * PAER(JL, JAE, IK)
     301              ZOMGA(JK, JSW) = ZOMGA(JK, JSW) + RSRTAUA(JSW, JAE) * PAER(JL, JAE, IK) &
     302                      & * RSRPIZA(JSW, JAE)
     303              ZASYA(JK, JSW) = ZASYA(JK, JSW) + RSRTAUA(JSW, JAE) * PAER(JL, JAE, IK) &
     304                      & * RSRPIZA(JSW, JAE) * RSRASYA(JSW, JAE)
     305            ENDDO
     306            IF (ZOMGA(JK, JSW) /= 0.0_JPRB) THEN
     307              ZASYA(JK, JSW) = ZASYA(JK, JSW) / ZOMGA(JK, JSW)
     308            ENDIF
     309            IF (ZTAUA(JK, JSW) /= 0.0_JPRB) THEN
     310              ZOMGA(JK, JSW) = ZOMGA(JK, JSW) / ZTAUA(JK, JSW)
     311            ENDIF
     312            !      print 9003,JSW,JK,ZTAUA(JK,JSW),ZOMGA(JK,JSW),ZASYA(JK,JSW)
     313            9003  format(1x, 'Aerosols ', 2I3, 3F10.4)
     314          ENDDO
     315        ENDDO
    219316      ENDIF
    220317
    221     ENDDO
    222 
    223 !  print *,'ZTOTCC ZCLEAR : ',ZTOTCC,' ',ZCLEAR
    224 
    225     DO IMOL=1,I_NMOL
    226       DO JK=1,KLEV
    227         Z_WKL(IMOL,JK)=Z_COLDRY(JK)* Z_WKL(IMOL,JK)
    228       ENDDO
    229     ENDDO
    230 
    231 !    IF (ZTOTCC == 0.0_JPRB) THEN
    232 !      DO JK=1,KLEV
    233 !        ZFRCL(JK)=0.0_JPRB   
    234 !      ENDDO
    235 !    ELSE
    236 !      DO JK=1,KLEV
    237 !        ZFRCL(JK)=PFRCL(JL,JK)/ZTOTCC
    238 !      ENDDO
    239 !    ENDIF
    240 
    241 !  print *,'just before SRTM_SETCOEF'
    242 
    243     ZFRCL(1:KLEV)=PFRCL(JL,1:KLEV)
    244     ZCLEAR=0._JPRB
    245     ZCLOUD=1._JPRB
    246 
    247     CALL SRTM_SETCOEF &
    248      & ( KLEV   , I_NMOL,&
    249      & Z_PAVEL  , Z_TAVEL   , Z_PZ     , Z_TZ     , Z_TBOUND,&
    250      & Z_COLDRY , Z_WKL,&
    251      & I_LAYTROP, I_LAYSWTCH, I_LAYLOW,&
    252      & Z_CO2MULT, Z_COLCH4  , Z_COLCO2 , Z_COLH2O , Z_COLMOL  , Z_COLN2O  , Z_COLO2 , Z_COLO3,&
    253      & Z_FORFAC , Z_FORFRAC , INDFOR , Z_SELFFAC, Z_SELFFRAC, INDSELF,&
    254      & Z_FAC00  , Z_FAC01   , Z_FAC10  , Z_FAC11,&
    255      & JP     , JT      , JT1     &
    256      & ) 
    257  
    258 !  print *,'just after SRTM_SETCOEF'
    259 
    260 !- call the radiation transfer routine
    261  
    262     DO JSW=1,KSW
    263       ZALBD(JSW)=PALBD(JL,JSW)
    264       ZALBP(JSW)=PALBP(JL,JSW)
    265       DO JK=1,KLEV
    266         ZTAUC(JK,JSW) = PTAUC(JL,JSW,JK)
    267         ZASYC(JK,JSW) = PASYC(JL,JSW,JK)
    268         ZOMGC(JK,JSW) = POMGC(JL,JSW,JK)
    269 !      print 9002,JSW,JK,ZFRCL(JK),ZTAUC(JK,JSW),ZASYC(JK,JSW),ZOMGC(JK,JSW)
    270         9002  format(1x,'srtm_224gp ClOPropECmodel ',2I3,f8.4,3E12.5)
    271       ENDDO
    272     ENDDO
    273 
    274 !- mixing of aerosols
    275  
    276 !  print *,'Aerosol optical properties computations'
    277 !  DO JSW=1,KSW
    278 !    print 9012,JSW,(JAE,RSRTAUA(JSW,JAE),RSRPIZA(JSW,JAE),RSRASYA(JSW,JAE),JAE=1,6)
    279     9012 format(I3,(/,I3,3E13.5))
    280 !  ENDDO
    281 
    282 !  DO JK=1,KLEV
    283 !    print 9013,JK,(PAER(JL,JAE,JK),JAE=1,6)
    284     9013 format(1x,I3,6E12.5)
    285 !  ENDDO
    286 
    287     IF (NAER == 0) THEN
    288       DO JSW=1,KSW
    289         DO JK=1,KLEV
    290           ZTAUA(JK,JSW)= 0.0_JPRB
    291           ZASYA(JK,JSW)= 0.0_JPRB
    292           ZOMGA(JK,JSW)= 1.0_JPRB
    293         ENDDO
    294       ENDDO
     318      DO JK = 1, KLEV + 1
     319        ZBBCU(JK) = 0.0_JPRB
     320        ZBBCD(JK) = 0.0_JPRB
     321        ZBBFU(JK) = 0.0_JPRB
     322        ZBBFD(JK) = 0.0_JPRB
     323        ZUVCU(JK) = 0.0_JPRB
     324        ZUVCD(JK) = 0.0_JPRB
     325        ZUVFU(JK) = 0.0_JPRB
     326        ZUVFD(JK) = 0.0_JPRB
     327        ZVSCU(JK) = 0.0_JPRB
     328        ZVSCD(JK) = 0.0_JPRB
     329        ZVSFU(JK) = 0.0_JPRB
     330        ZVSFD(JK) = 0.0_JPRB
     331        ZNICU(JK) = 0.0_JPRB
     332        ZNICD(JK) = 0.0_JPRB
     333        ZNIFU(JK) = 0.0_JPRB
     334        ZNIFD(JK) = 0.0_JPRB
     335      ENDDO
     336
     337      !  print *,'just before calling STRM_SPCVRT for JL=',JL,' and ZRMU0=',ZRMU0
     338
     339      CALL SRTM_SPCVRT &
     340              & (KLEV, I_NMOL, KSW, Z_ONEMINUS, &
     341              & Z_PAVEL, Z_TAVEL, Z_PZ, Z_TZ, Z_TBOUND, ZALBD, ZALBP, &
     342              & ZFRCL, ZTAUC, ZASYC, ZOMGC, ZTAUA, ZASYA, ZOMGA, ZRMU0, &
     343              & Z_COLDRY, Z_WKL, &
     344              & I_LAYTROP, I_LAYSWTCH, I_LAYLOW, &
     345              & Z_CO2MULT, Z_COLCH4, Z_COLCO2, Z_COLH2O, Z_COLMOL, Z_COLN2O, Z_COLO2, Z_COLO3, &
     346              & Z_FORFAC, Z_FORFRAC, INDFOR, Z_SELFFAC, Z_SELFFRAC, INDSELF, &
     347              & Z_FAC00, Z_FAC01, Z_FAC10, Z_FAC11, &
     348              & JP, JT, JT1, &
     349              & ZBBFD, ZBBFU, ZUVFD, ZUVFU, ZVSFD, ZVSFU, ZNIFD, ZNIFU, &
     350              & ZBBCD, ZBBCU, ZUVCD, ZUVCU, ZVSCD, ZVSCU, ZNICD, ZNICU &
     351              &)
     352
     353      !  print *,'SRTM_SRTM_224GP before potential scaling'
     354      !    IF (IOVLP == 3) THEN
     355      !      DO JK=1,KLEV+1
     356      !!      print 9004,JK,ZBBCU(JK),ZBBCD(JK),ZBBFU(JK),ZBBFD(JK)
     357      9004 format(1x, 'Clear-sky and total fluxes U & D ', I3, 4F10.3)
     358      !        PFSUC(JL,1,JK)=ZBBCU(JK)
     359      !        PFSUC(JL,2,JK)=ZBBCD(JK)
     360      !        PFSUX(JL,1,JK)=ZBBFU(JK)
     361      !        PFSUX(JL,2,JK)=ZBBFD(JK)
     362      !      ENDDO
     363      !    ELSE
     364      !    print *,'SRTM_SRTM_224GP after potential scaling'
     365      DO JK = 1, KLEV + 1
     366        PFSUC(JL, 1, JK) = ZADJI0 * ZBBCU(JK)
     367        PFSUC(JL, 2, JK) = ZADJI0 * ZBBCD(JK)
     368        PFSUX(JL, 1, JK) = ZADJI0 * ((1.0_JPRB - ZCLEAR) * ZBBFU(JK) + ZCLEAR * ZBBCU(JK))
     369        PFSUX(JL, 2, JK) = ZADJI0 * ((1.0_JPRB - ZCLEAR) * ZBBFD(JK) + ZCLEAR * ZBBCD(JK))
     370      ENDDO
     371      !    ENDIF
     372
     373      !  DO JK=1,KLEV+1
     374      !    print 9005,JK,PFSUC(JL,1,JK),PFSUC(JL,2,JK),PFSUX(JL,1,JK),PFSUX(JL,2,JK)
     375      9005 format(1x, 'Clear-sky and total fluxes U & D ', I3, 4F10.3)
     376      !  ENDDO
     377
    295378    ELSE
    296       DO JSW=1,KSW
    297         DO JK=1,KLEV
    298           IK=KLEV+1-JK
    299           ZTAUA(JK,JSW)=0.0_JPRB
    300           ZASYA(JK,JSW)=0.0_JPRB
    301           ZOMGA(JK,JSW)=0.0_JPRB
    302           DO JAE=1,6
    303             ZTAUA(JK,JSW)=ZTAUA(JK,JSW)+RSRTAUA(JSW,JAE)*PAER(JL,JAE,IK)
    304             ZOMGA(JK,JSW)=ZOMGA(JK,JSW)+RSRTAUA(JSW,JAE)*PAER(JL,JAE,IK) &
    305              & *RSRPIZA(JSW,JAE) 
    306             ZASYA(JK,JSW)=ZASYA(JK,JSW)+RSRTAUA(JSW,JAE)*PAER(JL,JAE,IK) &
    307              & *RSRPIZA(JSW,JAE)*RSRASYA(JSW,JAE) 
    308           ENDDO
    309           IF (ZOMGA(JK,JSW) /= 0.0_JPRB) THEN
    310             ZASYA(JK,JSW)=ZASYA(JK,JSW)/ZOMGA(JK,JSW)
    311           ENDIF
    312           IF (ZTAUA(JK,JSW) /= 0.0_JPRB) THEN
    313             ZOMGA(JK,JSW)=ZOMGA(JK,JSW)/ZTAUA(JK,JSW)
    314           ENDIF
    315 !      print 9003,JSW,JK,ZTAUA(JK,JSW),ZOMGA(JK,JSW),ZASYA(JK,JSW)
    316 9003  format(1x,'Aerosols ',2I3,3F10.4)
    317         ENDDO
     379      DO JK = 1, KLEV + 1
     380        PFSUC(JL, 1, JK) = 0.0_JPRB
     381        PFSUC(JL, 2, JK) = 0.0_JPRB
     382        PFSUX(JL, 1, JK) = 0.0_JPRB
     383        PFSUX(JL, 2, JK) = 0.0_JPRB
    318384      ENDDO
    319385    ENDIF
    320 
    321     DO JK=1,KLEV+1
    322       ZBBCU(JK)=0.0_JPRB
    323       ZBBCD(JK)=0.0_JPRB
    324       ZBBFU(JK)=0.0_JPRB
    325       ZBBFD(JK)=0.0_JPRB
    326       ZUVCU(JK)=0.0_JPRB
    327       ZUVCD(JK)=0.0_JPRB
    328       ZUVFU(JK)=0.0_JPRB
    329       ZUVFD(JK)=0.0_JPRB
    330       ZVSCU(JK)=0.0_JPRB
    331       ZVSCD(JK)=0.0_JPRB
    332       ZVSFU(JK)=0.0_JPRB
    333       ZVSFD(JK)=0.0_JPRB
    334       ZNICU(JK)=0.0_JPRB
    335       ZNICD(JK)=0.0_JPRB
    336       ZNIFU(JK)=0.0_JPRB
    337       ZNIFD(JK)=0.0_JPRB
    338     ENDDO
    339 
    340 !  print *,'just before calling STRM_SPCVRT for JL=',JL,' and ZRMU0=',ZRMU0
    341 
    342     CALL SRTM_SPCVRT &
    343      & ( KLEV   , I_NMOL    , KSW    , Z_ONEMINUS,&
    344      & Z_PAVEL  , Z_TAVEL   , Z_PZ     , Z_TZ     , Z_TBOUND  , ZALBD   , ZALBP,&
    345      & ZFRCL  , ZTAUC   , ZASYC  , ZOMGC  , ZTAUA   , ZASYA   , ZOMGA , ZRMU0,&
    346      & Z_COLDRY , Z_WKL,&
    347      & I_LAYTROP, I_LAYSWTCH, I_LAYLOW,&
    348      & Z_CO2MULT, Z_COLCH4  , Z_COLCO2 , Z_COLH2O , Z_COLMOL  , Z_COLN2O  , Z_COLO2 , Z_COLO3,&
    349      & Z_FORFAC , Z_FORFRAC , INDFOR , Z_SELFFAC, Z_SELFFRAC, INDSELF,&
    350      & Z_FAC00  , Z_FAC01   , Z_FAC10  , Z_FAC11,&
    351      & JP     , JT      , JT1,&
    352      & ZBBFD  , ZBBFU   , ZUVFD  , ZUVFU  , ZVSFD   , ZVSFU   , ZNIFD , ZNIFU,&
    353      & ZBBCD  , ZBBCU   , ZUVCD  , ZUVCU  , ZVSCD   , ZVSCU   , ZNICD , ZNICU &
    354      & ) 
    355 
    356 !  print *,'SRTM_SRTM_224GP before potential scaling'
    357 !    IF (IOVLP == 3) THEN
    358 !      DO JK=1,KLEV+1
    359 !!      print 9004,JK,ZBBCU(JK),ZBBCD(JK),ZBBFU(JK),ZBBFD(JK)
    360         9004 format(1x,'Clear-sky and total fluxes U & D ',I3,4F10.3)
    361 !        PFSUC(JL,1,JK)=ZBBCU(JK)
    362 !        PFSUC(JL,2,JK)=ZBBCD(JK)
    363 !        PFSUX(JL,1,JK)=ZBBFU(JK)
    364 !        PFSUX(JL,2,JK)=ZBBFD(JK)
    365 !      ENDDO
    366 !    ELSE
    367 !    print *,'SRTM_SRTM_224GP after potential scaling'
    368       DO JK=1,KLEV+1
    369         PFSUC(JL,1,JK)=ZADJI0 * ZBBCU(JK)
    370         PFSUC(JL,2,JK)=ZADJI0 * ZBBCD(JK)
    371         PFSUX(JL,1,JK)=ZADJI0 * ( (1.0_JPRB-ZCLEAR)*ZBBFU(JK)+ZCLEAR*ZBBCU(JK) )
    372         PFSUX(JL,2,JK)=ZADJI0 * ( (1.0_JPRB-ZCLEAR)*ZBBFD(JK)+ZCLEAR*ZBBCD(JK) )
    373       ENDDO
    374 !    ENDIF
    375 
    376 !  DO JK=1,KLEV+1
    377 !    print 9005,JK,PFSUC(JL,1,JK),PFSUC(JL,2,JK),PFSUX(JL,1,JK),PFSUX(JL,2,JK)
    378     9005 format(1x,'Clear-sky and total fluxes U & D ',I3,4F10.3)
    379 !  ENDDO
    380  
    381   ELSE
    382     DO JK=1,KLEV+1
    383       PFSUC(JL,1,JK)=0.0_JPRB
    384       PFSUC(JL,2,JK)=0.0_JPRB
    385       PFSUX(JL,1,JK)=0.0_JPRB
    386       PFSUX(JL,2,JK)=0.0_JPRB
    387     ENDDO
    388   ENDIF
    389 ENDDO
    390 
    391 !PRINT *,'OUT OF SRTM_224GP'
    392 
    393 !-----------------------------------------------------------------------
    394 IF (LHOOK) CALL DR_HOOK('SRTM_SRTM_224GP',1,ZHOOK_HANDLE)
     386  ENDDO
     387
     388  !PRINT *,'OUT OF SRTM_224GP'
     389
     390  !-----------------------------------------------------------------------
     391  IF (LHOOK) CALL DR_HOOK('SRTM_SRTM_224GP', 1, ZHOOK_HANDLE)
    395392END SUBROUTINE SRTM_SRTM_224GP
    396393

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/srtm_srtm_224gp_mcica.F90

    r2626 r5154  
    11SUBROUTINE SRTM_SRTM_224GP_MCICA &
    2  & ( KIDIA , KFDIA  , KLON  , KLEV  , KSW , KCOLS , KCLDLY ,&
    3  &   PAER  , PALBD  , PALBP , PAPH  , PAP , &
    4  &   PTS   , PTH    , PT    ,&
    5  &   PQ    , PCCO2  , POZN  , PRMU0 ,&
    6  &   PFRCL , PTAUC  , PASYC , POMGC ,&
    7  &   PFSUX , PFSUC &
    8  & ) 
    9 
    10 !-- interface to RRTM_SW
    11 !     JJMorcrette 030225
    12 !     JJMorcrette 20050110  McICA version
    13 
    14 USE PARKIND1  ,ONLY : JPIM     ,JPRB
    15 USE YOMHOOK   ,ONLY : LHOOK,  DR_HOOK
    16 
    17 USE PARSRTM  , ONLY : JPLAY
    18 !MPL/IM 20160915 on prend GES de phylmd USE YOERDI   , ONLY : RCH4   , RN2O   
    19 USE YOERAD   , ONLY : NAER
    20 USE YOESRTAER, ONLY : RSRTAUA, RSRPIZA, RSRASYA
    21 USE YOMPHY3  , ONLY : RII0
    22 USE YOMCST   , ONLY : RI0
    23 
    24 IMPLICIT NONE
    25 
    26 !-- Input arguments
    27 
    28 INTEGER(KIND=JPIM),INTENT(IN)    :: KLON
    29 INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
    30 INTEGER(KIND=JPIM),INTENT(IN)    :: KSW 
    31 INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
    32 INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
    33 INTEGER(KIND=JPIM),INTENT(IN)    :: KCOLS
    34 INTEGER(KIND=JPIM),INTENT(IN)    :: KCLDLY(KCOLS)
    35 
    36 REAL(KIND=JPRB)   ,INTENT(IN)    :: PAER(KLON,6,KLEV)    ! top to bottom
    37 REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBD(KLON,KSW)
    38 REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBP(KLON,KSW)
    39 REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPH(KLON,KLEV+1)
    40 REAL(KIND=JPRB)   ,INTENT(IN)    :: PAP(KLON,KLEV)
    41 REAL(KIND=JPRB)   ,INTENT(IN)    :: PTS(KLON)
    42 REAL(KIND=JPRB)   ,INTENT(IN)    :: PTH(KLON,KLEV+1)
    43 REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KLON,KLEV)
    44 REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ(KLON,KLEV)
    45 REAL(KIND=JPRB)   ,INTENT(IN)    :: PCCO2
    46 REAL(KIND=JPRB)   ,INTENT(IN)    :: POZN(KLON,KLEV)
    47 REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMU0(KLON)
    48 
    49 REAL(KIND=JPRB)   ,INTENT(IN)    :: PFRCL(KLON,KCOLS,KLEV) ! bottom to top
    50 REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAUC(KLON,KCOLS,KLEV) ! bottom to top
    51 REAL(KIND=JPRB)   ,INTENT(IN)    :: PASYC(KLON,KCOLS,KLEV) ! bottom to top
    52 REAL(KIND=JPRB)   ,INTENT(IN)    :: POMGC(KLON,KCOLS,KLEV) ! bottom to top
    53 
    54 REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSUX(KLON,2,KLEV+1)
    55 REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSUC(KLON,2,KLEV+1)
    56 
    57 !-- Output arguments
    58 
    59 !-----------------------------------------------------------------------
    60 
    61 !-- dummy integers
    62 
    63 INTEGER(KIND=JPIM) :: ICLDATM, INFLAG, ICEFLAG, I_LIQFLAG, ITMOL, I_NSTR
    64 
    65 INTEGER(KIND=JPIM) :: IK, IMOL, J1, J2, JAE, JL, JK, JSW
    66 
    67 !-- dummy reals
    68 
    69 REAL(KIND=JPRB) :: ZPZ(0:JPLAY)   , ZTZ(0:JPLAY)   , ZPAVEL(JPLAY)  , ZTAVEL(JPLAY)
    70 REAL(KIND=JPRB) :: ZCOLDRY(JPLAY) , ZCOLMOL(JPLAY) , ZWKL(35,JPLAY)
    71 REAL(KIND=JPRB) :: ZCO2MULT(JPLAY), ZCOLCH4(JPLAY) , ZCOLCO2(JPLAY) , ZCOLH2O(JPLAY)
    72 REAL(KIND=JPRB) :: ZCOLN2O(JPLAY) , ZCOLO2(JPLAY)  , ZCOLO3(JPLAY)
    73 REAL(KIND=JPRB) :: ZFORFAC(JPLAY) , ZFORFRAC(JPLAY), ZSELFFAC(JPLAY), ZSELFFRAC(JPLAY)
    74 REAL(KIND=JPRB) :: ZFAC00(JPLAY)  , ZFAC01(JPLAY)  , ZFAC10(JPLAY)  , ZFAC11(JPLAY)
    75 REAL(KIND=JPRB) :: ZTBOUND        , ZONEMINUS    , ZRMU0 , ZADJI0
    76 REAL(KIND=JPRB) :: ZALBD(KSW)    , ZALBP(KSW)   
    77 
    78 REAL(KIND=JPRB) :: ZFRCL(KCOLS,JPLAY), ZTAUC(JPLAY,KCOLS), ZASYC(JPLAY,KCOLS), ZOMGC(JPLAY,KCOLS)
    79 REAL(KIND=JPRB) :: ZTAUA(JPLAY,KSW), ZASYA(JPLAY,KSW), ZOMGA(JPLAY,KSW)
    80 
    81 REAL(KIND=JPRB) :: ZBBCD(JPLAY+1), ZBBCU(JPLAY+1), ZBBFD(JPLAY+1), ZBBFU(JPLAY+1)
    82 !REAL(KIND=JPRB) :: ZUVCD(JPLAY+1), ZUVCU(JPLAY+1), ZUVFD(JPLAY+1), ZUVFU(JPLAY+1)
    83 !REAL(KIND=JPRB) :: ZVSCD(JPLAY+1), ZVSCU(JPLAY+1), ZVSFD(JPLAY+1), ZVSFU(JPLAY+1)
    84 !REAL(KIND=JPRB) :: ZNICD(JPLAY+1), ZNICU(JPLAY+1), ZNIFD(JPLAY+1), ZNIFU(JPLAY+1)
    85 
    86 INTEGER(KIND=JPIM) :: ILAYTROP, ILAYSWTCH, ILAYLOW
    87 INTEGER(KIND=JPIM) :: INDFOR(JPLAY), INDSELF(JPLAY)
    88 INTEGER(KIND=JPIM) :: JP(JPLAY), JT(JPLAY), JT1(JPLAY)
    89 
    90 REAL(KIND=JPRB) :: ZAMD                  ! Effective molecular weight of dry air (g/mol)
    91 REAL(KIND=JPRB) :: ZAMW                  ! Molecular weight of water vapor (g/mol)
    92 REAL(KIND=JPRB) :: ZAMCO2                ! Molecular weight of carbon dioxide (g/mol)
    93 REAL(KIND=JPRB) :: ZAMO                  ! Molecular weight of ozone (g/mol)
    94 REAL(KIND=JPRB) :: ZAMCH4                ! Molecular weight of methane (g/mol)
    95 REAL(KIND=JPRB) :: ZAMN2O                ! Molecular weight of nitrous oxide (g/mol)
    96 REAL(KIND=JPRB) :: ZAMC11                ! Molecular weight of CFC11 (g/mol) - CFCL3
    97 REAL(KIND=JPRB) :: ZAMC12                ! Molecular weight of CFC12 (g/mol) - CF2CL2
    98 REAL(KIND=JPRB) :: ZAVGDRO               ! Avogadro's number (molecules/mole)
    99 REAL(KIND=JPRB) :: ZGRAVIT               ! Gravitational acceleration (cm/sec2)
    100 REAL(KIND=JPRB) :: ZAMM
    101 
    102 REAL(KIND=JPRB) :: RAMW                  ! Molecular weight of water vapor (g/mol)
    103 REAL(KIND=JPRB) :: RAMCO2                ! Molecular weight of carbon dioxide (g/mol)
    104 REAL(KIND=JPRB) :: RAMO                  ! Molecular weight of ozone (g/mol)
    105 REAL(KIND=JPRB) :: RAMCH4                ! Molecular weight of methane (g/mol)
    106 REAL(KIND=JPRB) :: RAMN2O                ! Molecular weight of nitrous oxide (g/mol)
    107 
    108 ! Atomic weights for conversion from mass to volume mixing ratios; these
    109 !  are the same values used in ECRT to assure accurate conversion to vmr
    110 data ZAMD   /  28.970_JPRB    /
    111 data ZAMW   /  18.0154_JPRB   /
    112 data ZAMCO2 /  44.011_JPRB    /
    113 data ZAMO   /  47.9982_JPRB   /
    114 data ZAMCH4 /  16.043_JPRB    /
    115 data ZAMN2O /  44.013_JPRB    /
    116 data ZAMC11 / 137.3686_JPRB   /
    117 data ZAMC12 / 120.9140_JPRB   /
    118 data ZAVGDRO/ 6.02214E23_JPRB /
    119 data ZGRAVIT/ 9.80665E02_JPRB /
    120 data RAMW   /  0.05550_JPRB  /
    121 data RAMCO2 /  0.02272_JPRB   /
    122 data RAMO   /  0.02083_JPRB   /
    123 data RAMCH4 /  0.06233_JPRB    /
    124 data RAMN2O /  0.02272_JPRB    /
    125 
    126 
    127 REAL(KIND=JPRB) :: ZCLEAR, ZCLOUD, ZEPSEC, ZTOTCC
    128 
    129 INTEGER(KIND=JPIM) :: IOVLP
    130 REAL(KIND=JPRB) :: ZHOOK_HANDLE
     2        & (KIDIA, KFDIA, KLON, KLEV, KSW, KCOLS, KCLDLY, &
     3        &   PAER, PALBD, PALBP, PAPH, PAP, &
     4        &   PTS, PTH, PT, &
     5        &   PQ, PCCO2, POZN, PRMU0, &
     6        &   PFRCL, PTAUC, PASYC, POMGC, &
     7        &   PFSUX, PFSUC &
     8        &)
     9
     10  !-- interface to RRTM_SW
     11  !     JJMorcrette 030225
     12  !     JJMorcrette 20050110  McICA version
     13
     14  USE PARKIND1, ONLY: JPIM, JPRB
     15  USE YOMHOOK, ONLY: LHOOK, DR_HOOK
     16
     17  USE PARSRTM, ONLY: JPLAY
     18  !MPL/IM 20160915 on prend GES de phylmd USE YOERDI   , ONLY : RCH4   , RN2O
     19  USE YOERAD, ONLY: NAER
     20  USE YOESRTAER, ONLY: RSRTAUA, RSRPIZA, RSRASYA
     21  USE YOMPHY3, ONLY: RII0
     22  USE YOMCST, ONLY: RI0
     23  USE lmdz_clesphys
     24
     25  IMPLICIT NONE
     26
     27  !-- Input arguments
     28
     29  INTEGER(KIND = JPIM), INTENT(IN) :: KLON
     30  INTEGER(KIND = JPIM), INTENT(IN) :: KLEV
     31  INTEGER(KIND = JPIM), INTENT(IN) :: KSW
     32  INTEGER(KIND = JPIM), INTENT(IN) :: KIDIA
     33  INTEGER(KIND = JPIM), INTENT(IN) :: KFDIA
     34  INTEGER(KIND = JPIM), INTENT(IN) :: KCOLS
     35  INTEGER(KIND = JPIM), INTENT(IN) :: KCLDLY(KCOLS)
     36
     37  REAL(KIND = JPRB), INTENT(IN) :: PAER(KLON, 6, KLEV)    ! top to bottom
     38  REAL(KIND = JPRB), INTENT(IN) :: PALBD(KLON, KSW)
     39  REAL(KIND = JPRB), INTENT(IN) :: PALBP(KLON, KSW)
     40  REAL(KIND = JPRB), INTENT(IN) :: PAPH(KLON, KLEV + 1)
     41  REAL(KIND = JPRB), INTENT(IN) :: PAP(KLON, KLEV)
     42  REAL(KIND = JPRB), INTENT(IN) :: PTS(KLON)
     43  REAL(KIND = JPRB), INTENT(IN) :: PTH(KLON, KLEV + 1)
     44  REAL(KIND = JPRB), INTENT(IN) :: PT(KLON, KLEV)
     45  REAL(KIND = JPRB), INTENT(IN) :: PQ(KLON, KLEV)
     46  REAL(KIND = JPRB), INTENT(IN) :: PCCO2
     47  REAL(KIND = JPRB), INTENT(IN) :: POZN(KLON, KLEV)
     48  REAL(KIND = JPRB), INTENT(IN) :: PRMU0(KLON)
     49
     50  REAL(KIND = JPRB), INTENT(IN) :: PFRCL(KLON, KCOLS, KLEV) ! bottom to top
     51  REAL(KIND = JPRB), INTENT(IN) :: PTAUC(KLON, KCOLS, KLEV) ! bottom to top
     52  REAL(KIND = JPRB), INTENT(IN) :: PASYC(KLON, KCOLS, KLEV) ! bottom to top
     53  REAL(KIND = JPRB), INTENT(IN) :: POMGC(KLON, KCOLS, KLEV) ! bottom to top
     54
     55  REAL(KIND = JPRB), INTENT(OUT) :: PFSUX(KLON, 2, KLEV + 1)
     56  REAL(KIND = JPRB), INTENT(OUT) :: PFSUC(KLON, 2, KLEV + 1)
     57
     58  !-- Output arguments
     59
     60  !-----------------------------------------------------------------------
     61
     62  !-- dummy integers
     63
     64  INTEGER(KIND = JPIM) :: ICLDATM, INFLAG, ICEFLAG, I_LIQFLAG, ITMOL, I_NSTR
     65
     66  INTEGER(KIND = JPIM) :: IK, IMOL, J1, J2, JAE, JL, JK, JSW
     67
     68  !-- dummy reals
     69
     70  REAL(KIND = JPRB) :: ZPZ(0:JPLAY), ZTZ(0:JPLAY), ZPAVEL(JPLAY), ZTAVEL(JPLAY)
     71  REAL(KIND = JPRB) :: ZCOLDRY(JPLAY), ZCOLMOL(JPLAY), ZWKL(35, JPLAY)
     72  REAL(KIND = JPRB) :: ZCO2MULT(JPLAY), ZCOLCH4(JPLAY), ZCOLCO2(JPLAY), ZCOLH2O(JPLAY)
     73  REAL(KIND = JPRB) :: ZCOLN2O(JPLAY), ZCOLO2(JPLAY), ZCOLO3(JPLAY)
     74  REAL(KIND = JPRB) :: ZFORFAC(JPLAY), ZFORFRAC(JPLAY), ZSELFFAC(JPLAY), ZSELFFRAC(JPLAY)
     75  REAL(KIND = JPRB) :: ZFAC00(JPLAY), ZFAC01(JPLAY), ZFAC10(JPLAY), ZFAC11(JPLAY)
     76  REAL(KIND = JPRB) :: ZTBOUND, ZONEMINUS, ZRMU0, ZADJI0
     77  REAL(KIND = JPRB) :: ZALBD(KSW), ZALBP(KSW)
     78
     79  REAL(KIND = JPRB) :: ZFRCL(KCOLS, JPLAY), ZTAUC(JPLAY, KCOLS), ZASYC(JPLAY, KCOLS), ZOMGC(JPLAY, KCOLS)
     80  REAL(KIND = JPRB) :: ZTAUA(JPLAY, KSW), ZASYA(JPLAY, KSW), ZOMGA(JPLAY, KSW)
     81
     82  REAL(KIND = JPRB) :: ZBBCD(JPLAY + 1), ZBBCU(JPLAY + 1), ZBBFD(JPLAY + 1), ZBBFU(JPLAY + 1)
     83  !REAL(KIND=JPRB) :: ZUVCD(JPLAY+1), ZUVCU(JPLAY+1), ZUVFD(JPLAY+1), ZUVFU(JPLAY+1)
     84  !REAL(KIND=JPRB) :: ZVSCD(JPLAY+1), ZVSCU(JPLAY+1), ZVSFD(JPLAY+1), ZVSFU(JPLAY+1)
     85  !REAL(KIND=JPRB) :: ZNICD(JPLAY+1), ZNICU(JPLAY+1), ZNIFD(JPLAY+1), ZNIFU(JPLAY+1)
     86
     87  INTEGER(KIND = JPIM) :: ILAYTROP, ILAYSWTCH, ILAYLOW
     88  INTEGER(KIND = JPIM) :: INDFOR(JPLAY), INDSELF(JPLAY)
     89  INTEGER(KIND = JPIM) :: JP(JPLAY), JT(JPLAY), JT1(JPLAY)
     90
     91  REAL(KIND = JPRB) :: ZAMD                  ! Effective molecular weight of dry air (g/mol)
     92  REAL(KIND = JPRB) :: ZAMW                  ! Molecular weight of water vapor (g/mol)
     93  REAL(KIND = JPRB) :: ZAMCO2                ! Molecular weight of carbon dioxide (g/mol)
     94  REAL(KIND = JPRB) :: ZAMO                  ! Molecular weight of ozone (g/mol)
     95  REAL(KIND = JPRB) :: ZAMCH4                ! Molecular weight of methane (g/mol)
     96  REAL(KIND = JPRB) :: ZAMN2O                ! Molecular weight of nitrous oxide (g/mol)
     97  REAL(KIND = JPRB) :: ZAMC11                ! Molecular weight of CFC11 (g/mol) - CFCL3
     98  REAL(KIND = JPRB) :: ZAMC12                ! Molecular weight of CFC12 (g/mol) - CF2CL2
     99  REAL(KIND = JPRB) :: ZAVGDRO               ! Avogadro's number (molecules/mole)
     100  REAL(KIND = JPRB) :: ZGRAVIT               ! Gravitational acceleration (cm/sec2)
     101  REAL(KIND = JPRB) :: ZAMM
     102
     103  REAL(KIND = JPRB) :: RAMW                  ! Molecular weight of water vapor (g/mol)
     104  REAL(KIND = JPRB) :: RAMCO2                ! Molecular weight of carbon dioxide (g/mol)
     105  REAL(KIND = JPRB) :: RAMO                  ! Molecular weight of ozone (g/mol)
     106  REAL(KIND = JPRB) :: RAMCH4                ! Molecular weight of methane (g/mol)
     107  REAL(KIND = JPRB) :: RAMN2O                ! Molecular weight of nitrous oxide (g/mol)
     108
     109  ! Atomic weights for conversion from mass to volume mixing ratios; these
     110  !  are the same values used in ECRT to assure accurate conversion to vmr
     111  data ZAMD   /  28.970_JPRB    /
     112  data ZAMW   /  18.0154_JPRB   /
     113  data ZAMCO2 /  44.011_JPRB    /
     114  data ZAMO   /  47.9982_JPRB   /
     115  data ZAMCH4 /  16.043_JPRB    /
     116  data ZAMN2O /  44.013_JPRB    /
     117  data ZAMC11 / 137.3686_JPRB   /
     118  data ZAMC12 / 120.9140_JPRB  /
     119  data ZAVGDRO/ 6.02214E23_JPRB /
     120  data ZGRAVIT/ 9.80665E02_JPRB /
     121  data RAMW   /  0.05550_JPRB   /
     122  data RAMCO2 /  0.02272_JPRB   /
     123  data RAMO   /  0.02083_JPRB   /
     124  data RAMCH4 /  0.06233_JPRB    /
     125  data RAMN2O /  0.02272_JPRB    /
     126
     127  REAL(KIND = JPRB) :: ZCLEAR, ZCLOUD, ZEPSEC, ZTOTCC
     128
     129  INTEGER(KIND = JPIM) :: IOVLP
     130  REAL(KIND = JPRB) :: ZHOOK_HANDLE
    131131
    132132
    133133#include "srtm_setcoef.intfb.h"
    134134#include "srtm_spcvrt_mcica.intfb.h"
    135 !MPL/IM 20160915 on prend GES de phylmd
    136 #include "clesphys.h"
    137 
    138 !-----------------------------------------------------------------------
    139 !-- calculate information needed ny the radiative transfer routine
    140 
    141 IF (LHOOK) CALL DR_HOOK('SRTM_SRTM_224GP_MCICA',0,ZHOOK_HANDLE)
    142 ZEPSEC  = 1.E-06_JPRB
    143 ZONEMINUS=1.0_JPRB -  ZEPSEC
    144 ZADJI0 = RII0 / RI0
    145 !-- overlap: 1=max-ran, 2=maximum, 3=random
    146 IOVLP=3
    147 
    148 !print *,'Entering srtm_srtm_224gp_mcica'
    149 
    150 ICLDATM  = 1
    151 INFLAG   = 2
    152 ICEFLAG  = 3
    153 I_LIQFLAG= 1
    154 ITMOL    = 6
    155 I_NSTR   = 2
    156 
    157 DO JL = KIDIA, KFDIA
    158   ZRMU0=PRMU0(JL)
    159   IF (ZRMU0 > 0.0_JPRB) THEN
    160 
    161 !- coefficients related to the cloud optical properties (original RRTM_SW)
    162 
    163 !  print *,'just before SRTM_CLDPROP'
    164 
    165 !  DO JK=1,KLEV
    166 !    CLDFRAC(JK) = PFRCL (JL,JK)
    167 !    CLDDAT1(JK) = PSCLA1(JL,JK)
    168 !    CLDDAT2(JK) = PSCLA2(JL,JK)
    169 !    CLDDAT3(JK) = PSCLA3(JL,JK)
    170 !    CLDDAT4(JK) = PSCLA4(JL,JK)
    171 !    DO JMOM=0,16
    172 !      CLDDATMOM(JMOM,JK)=PSCLMOM(JL,JMOM,JK)
    173 !    ENDDO
    174 !    print 9101,JK,CLDFRAC(JK),CLDDAT1(JK),CLDDAT2(JK),CLDDAT3(JK)&
    175 !    &,CLDDAT4(JK),(CLDDATMOM(JMOM,JK),JMOM=0,NSTR)
    176     9101 format(1x,'srtm_srtm_224gp Cld :',I3,f7.4,7E12.5)
    177 !  ENDDO
    178 
    179 !  CALL SRTM_CLDPROP &
    180 !    &( KLEV, ICLDATM, INFLAG, ICEFLAG, LIQFLAG, NSTR &
    181 !    &, CLDFRAC, CLDDAT1, CLDDAT2, CLDDAT3, CLDDAT4, CLDDATMOM &
    182 !    &, TAUCLDORIG, TAUCLOUD, SSACLOUD, XMOM &
    183 !    &)
    184 
    185 !- coefficients for the temperature and pressure dependence of the
    186 ! molecular absorption coefficients
    187 
    188     DO J1=1,35
    189       DO J2=1,KLEV
    190         ZWKL(J1,J2)=0.0_JPRB
    191       ENDDO
    192     ENDDO
    193 
    194     ZTBOUND=PTS(JL)
    195     ZPZ(0) = paph(JL,klev+1)*0.01_JPRB
    196     ZTZ(0) = pth (JL,klev+1)
    197 
    198     ZCLEAR=1.0_JPRB
    199     ZCLOUD=0.0_JPRB
    200     ZTOTCC=0.0_JPRB
    201     DO JK = 1, KLEV
    202       ZPAVEL(JK) = pap(JL,KLEV-JK+1) *0.01_JPRB
    203       ZTAVEL(JK) = pt (JL,KLEV-JK+1)
    204       ZPZ(JK)    = paph(JL,KLEV-JK+1) *0.01_JPRB
    205       ZTZ(JK)    = pth (JL,KLEV-JK+1)
    206       ZWKL(1,JK) = pq(JL,KLEV-JK+1)  *ZAMD*RAMW
    207       ZWKL(2,JK) = pcco2             *ZAMD*RAMCO2
    208       ZWKL(3,JK) = pozn(JL,KLEV-JK+1)*ZAMD*RAMO
    209       ZWKL(4,JK) = rn2o              *ZAMD*RAMN2O
    210       ZWKL(6,JK) = rch4              *ZAMD*RAMCH4
    211       ZAMM = (1-ZWKL(1,JK))*ZAMD + ZWKL(1,JK)*ZAMW
    212       ZCOLDRY(JK) = (ZPZ(JK-1)-ZPZ(JK))*1.E3_JPRB*ZAVGDRO/(ZGRAVIT*ZAMM*(1+ZWKL(1,JK)))
    213 !    print 9200,JK,PAVEL(JK),TAVEL(JK),(WKL(JA,JK),JA=1,4),WKL(6,JK),COLDRY(JK)
    214       9200 format(1x,'SRTM ',I3,2F7.1,6E13.5)
    215 
    216 
    217 
    218     ENDDO
    219 
    220 !  print *,'ZTOTCC ZCLEAR : ',ZTOTCC,' ',ZCLEAR
    221 
    222     DO IMOL=1,ITMOL
    223       DO JK=1,KLEV
    224         ZWKL(IMOL,JK)=ZCOLDRY(JK)* ZWKL(IMOL,JK)
    225       ENDDO
    226     ENDDO
    227 
    228 !  print *,'just before SRTM_SETCOEF'
    229 
    230     CALL SRTM_SETCOEF &
    231      & ( KLEV   , ITMOL,&
    232      & ZPAVEL  , ZTAVEL   , ZPZ     , ZTZ     , ZTBOUND,&
    233      & ZCOLDRY , ZWKL,&
    234      & ILAYTROP, ILAYSWTCH, ILAYLOW,&
    235      & ZCO2MULT, ZCOLCH4  , ZCOLCO2 , ZCOLH2O , ZCOLMOL  , ZCOLN2O  , ZCOLO2 , ZCOLO3,&
    236      & ZFORFAC , ZFORFRAC , INDFOR  , ZSELFFAC, ZSELFFRAC, INDSELF, &
    237      & ZFAC00  , ZFAC01   , ZFAC10  , ZFAC11,&
    238      & JP      , JT       , JT1     &
    239      & ) 
    240  
    241 !  print *,'just after SRTM_SETCOEF'
    242 
    243 !- call the radiation transfer routine
    244  
    245     DO JSW=1,KSW
    246       ZALBD(JSW)=PALBD(JL,JSW)
    247       ZALBP(JSW)=PALBP(JL,JSW)
    248     ENDDO
    249 
    250     DO JSW=1,KCOLS
    251       DO JK=1,KLEV       
    252         ZFRCL(JSW,JK) = PFRCL(JL,JSW,JK)
    253         ZTAUC(JK,JSW) = PTAUC(JL,JSW,JK)
    254         ZASYC(JK,JSW) = PASYC(JL,JSW,JK)
    255         ZOMGC(JK,JSW) = POMGC(JL,JSW,JK)
    256 
    257 !---- security: might have to be moved upstream to radlswr -------
    258 !        IF(ZTAUC(JK,JSW) == 0._JPRB) ZFRCL(JSW,JK) = 0._JPRB
    259 !-----------------------------------------------------------------
    260 
    261 
    262 !       IF (ZFRCL(JSW,JK) /= 0._JPRB) THEN
    263 !          print 9002,JSW,JK,ZFRCL(JSW,JK),ZTAUC(JK,JSW),ZASYC(JK,JSW),ZOMGC(JK,JSW)
    264 9002      format(1x,'srtm_224gp_McICA ClOPropECmodel ',2I3,f8.4,3E12.5)
    265 !        ENDIF
    266       ENDDO
    267     ENDDO
    268 
    269 !- mixing of aerosols
    270  
    271 !  print *,'Aerosol optical properties computations'
    272 !  DO JSW=1,KSW
    273 !    print 9012,JSW,(JAE,RSRTAUA(JSW,JAE),RSRPIZA(JSW,JAE),RSRASYA(JSW,JAE),JAE=1,6)
    274     9012 format(I3,(/,I3,3E13.5))
    275 !  ENDDO
    276 
    277 !  DO JK=1,KLEV
    278 !    print 9013,JK,(PAER(JL,JAE,JK),JAE=1,6)
    279     9013 format(1x,I3,6E12.5)
    280 !  ENDDO
    281 
    282     IF (NAER == 0) THEN
    283       DO JSW=1,KSW
    284         DO JK=1,KLEV
    285           ZTAUA(JK,JSW)= 0.0_JPRB
    286           ZASYA(JK,JSW)= 0.0_JPRB
    287           ZOMGA(JK,JSW)= 1.0_JPRB
    288         ENDDO
    289       ENDDO
     135  !MPL/IM 20160915 on prend GES de phylmd
     136  !-----------------------------------------------------------------------
     137  !-- calculate information needed ny the radiative transfer routine
     138
     139  IF (LHOOK) CALL DR_HOOK('SRTM_SRTM_224GP_MCICA', 0, ZHOOK_HANDLE)
     140  ZEPSEC = 1.E-06_JPRB
     141  ZONEMINUS = 1.0_JPRB - ZEPSEC
     142  ZADJI0 = RII0 / RI0
     143  !-- overlap: 1=max-ran, 2=maximum, 3=random
     144  IOVLP = 3
     145
     146  !print *,'Entering srtm_srtm_224gp_mcica'
     147
     148  ICLDATM = 1
     149  INFLAG = 2
     150  ICEFLAG = 3
     151  I_LIQFLAG = 1
     152  ITMOL = 6
     153  I_NSTR = 2
     154
     155  DO JL = KIDIA, KFDIA
     156    ZRMU0 = PRMU0(JL)
     157    IF (ZRMU0 > 0.0_JPRB) THEN
     158
     159      !- coefficients related to the cloud optical properties (original RRTM_SW)
     160
     161      !  print *,'just before SRTM_CLDPROP'
     162
     163      !  DO JK=1,KLEV
     164      !    CLDFRAC(JK) = PFRCL (JL,JK)
     165      !    CLDDAT1(JK) = PSCLA1(JL,JK)
     166      !    CLDDAT2(JK) = PSCLA2(JL,JK)
     167      !    CLDDAT3(JK) = PSCLA3(JL,JK)
     168      !    CLDDAT4(JK) = PSCLA4(JL,JK)
     169      !    DO JMOM=0,16
     170      !      CLDDATMOM(JMOM,JK)=PSCLMOM(JL,JMOM,JK)
     171      !    ENDDO
     172      !    print 9101,JK,CLDFRAC(JK),CLDDAT1(JK),CLDDAT2(JK),CLDDAT3(JK)&
     173      !    &,CLDDAT4(JK),(CLDDATMOM(JMOM,JK),JMOM=0,NSTR)
     174      9101 format(1x, 'srtm_srtm_224gp Cld :', I3, f7.4, 7E12.5)
     175      !  ENDDO
     176
     177      !  CALL SRTM_CLDPROP &
     178      !    &( KLEV, ICLDATM, INFLAG, ICEFLAG, LIQFLAG, NSTR &
     179      !    &, CLDFRAC, CLDDAT1, CLDDAT2, CLDDAT3, CLDDAT4, CLDDATMOM &
     180      !    &, TAUCLDORIG, TAUCLOUD, SSACLOUD, XMOM &
     181      !    &)
     182
     183      !- coefficients for the temperature and pressure dependence of the
     184      ! molecular absorption coefficients
     185
     186      DO J1 = 1, 35
     187        DO J2 = 1, KLEV
     188          ZWKL(J1, J2) = 0.0_JPRB
     189        ENDDO
     190      ENDDO
     191
     192      ZTBOUND = PTS(JL)
     193      ZPZ(0) = paph(JL, klev + 1) * 0.01_JPRB
     194      ZTZ(0) = pth (JL, klev + 1)
     195
     196      ZCLEAR = 1.0_JPRB
     197      ZCLOUD = 0.0_JPRB
     198      ZTOTCC = 0.0_JPRB
     199      DO JK = 1, KLEV
     200        ZPAVEL(JK) = pap(JL, KLEV - JK + 1) * 0.01_JPRB
     201        ZTAVEL(JK) = pt (JL, KLEV - JK + 1)
     202        ZPZ(JK) = paph(JL, KLEV - JK + 1) * 0.01_JPRB
     203        ZTZ(JK) = pth (JL, KLEV - JK + 1)
     204        ZWKL(1, JK) = pq(JL, KLEV - JK + 1) * ZAMD * RAMW
     205        ZWKL(2, JK) = pcco2 * ZAMD * RAMCO2
     206        ZWKL(3, JK) = pozn(JL, KLEV - JK + 1) * ZAMD * RAMO
     207        ZWKL(4, JK) = rn2o * ZAMD * RAMN2O
     208        ZWKL(6, JK) = rch4 * ZAMD * RAMCH4
     209        ZAMM = (1 - ZWKL(1, JK)) * ZAMD + ZWKL(1, JK) * ZAMW
     210        ZCOLDRY(JK) = (ZPZ(JK - 1) - ZPZ(JK)) * 1.E3_JPRB * ZAVGDRO / (ZGRAVIT * ZAMM * (1 + ZWKL(1, JK)))
     211        !    print 9200,JK,PAVEL(JK),TAVEL(JK),(WKL(JA,JK),JA=1,4),WKL(6,JK),COLDRY(JK)
     212        9200 format(1x, 'SRTM ', I3, 2F7.1, 6E13.5)
     213
     214      ENDDO
     215
     216      !  print *,'ZTOTCC ZCLEAR : ',ZTOTCC,' ',ZCLEAR
     217
     218      DO IMOL = 1, ITMOL
     219        DO JK = 1, KLEV
     220          ZWKL(IMOL, JK) = ZCOLDRY(JK) * ZWKL(IMOL, JK)
     221        ENDDO
     222      ENDDO
     223
     224      !  print *,'just before SRTM_SETCOEF'
     225
     226      CALL SRTM_SETCOEF &
     227              & (KLEV, ITMOL, &
     228              & ZPAVEL, ZTAVEL, ZPZ, ZTZ, ZTBOUND, &
     229              & ZCOLDRY, ZWKL, &
     230              & ILAYTROP, ILAYSWTCH, ILAYLOW, &
     231              & ZCO2MULT, ZCOLCH4, ZCOLCO2, ZCOLH2O, ZCOLMOL, ZCOLN2O, ZCOLO2, ZCOLO3, &
     232              & ZFORFAC, ZFORFRAC, INDFOR, ZSELFFAC, ZSELFFRAC, INDSELF, &
     233              & ZFAC00, ZFAC01, ZFAC10, ZFAC11, &
     234              & JP, JT, JT1     &
     235              &)
     236
     237      !  print *,'just after SRTM_SETCOEF'
     238
     239      !- call the radiation transfer routine
     240
     241      DO JSW = 1, KSW
     242        ZALBD(JSW) = PALBD(JL, JSW)
     243        ZALBP(JSW) = PALBP(JL, JSW)
     244      ENDDO
     245
     246      DO JSW = 1, KCOLS
     247        DO JK = 1, KLEV
     248          ZFRCL(JSW, JK) = PFRCL(JL, JSW, JK)
     249          ZTAUC(JK, JSW) = PTAUC(JL, JSW, JK)
     250          ZASYC(JK, JSW) = PASYC(JL, JSW, JK)
     251          ZOMGC(JK, JSW) = POMGC(JL, JSW, JK)
     252
     253          !---- security: might have to be moved upstream to radlswr -------
     254          !        IF(ZTAUC(JK,JSW) == 0._JPRB) ZFRCL(JSW,JK) = 0._JPRB
     255          !-----------------------------------------------------------------
     256
     257
     258          !       IF (ZFRCL(JSW,JK) /= 0._JPRB) THEN
     259          !          print 9002,JSW,JK,ZFRCL(JSW,JK),ZTAUC(JK,JSW),ZASYC(JK,JSW),ZOMGC(JK,JSW)
     260          9002      format(1x, 'srtm_224gp_McICA ClOPropECmodel ', 2I3, f8.4, 3E12.5)
     261          !        ENDIF
     262        ENDDO
     263      ENDDO
     264
     265      !- mixing of aerosols
     266
     267      !  print *,'Aerosol optical properties computations'
     268      !  DO JSW=1,KSW
     269      !    print 9012,JSW,(JAE,RSRTAUA(JSW,JAE),RSRPIZA(JSW,JAE),RSRASYA(JSW,JAE),JAE=1,6)
     270      9012 format(I3, (/, I3, 3E13.5))
     271      !  ENDDO
     272
     273      !  DO JK=1,KLEV
     274      !    print 9013,JK,(PAER(JL,JAE,JK),JAE=1,6)
     275      9013 format(1x, I3, 6E12.5)
     276      !  ENDDO
     277
     278      IF (NAER == 0) THEN
     279        DO JSW = 1, KSW
     280          DO JK = 1, KLEV
     281            ZTAUA(JK, JSW) = 0.0_JPRB
     282            ZASYA(JK, JSW) = 0.0_JPRB
     283            ZOMGA(JK, JSW) = 1.0_JPRB
     284          ENDDO
     285        ENDDO
     286      ELSE
     287        DO JSW = 1, KSW
     288          DO JK = 1, KLEV
     289            IK = KLEV + 1 - JK
     290            ZTAUA(JK, JSW) = 0.0_JPRB
     291            ZASYA(JK, JSW) = 0.0_JPRB
     292            ZOMGA(JK, JSW) = 0.0_JPRB
     293            DO JAE = 1, 6
     294              ZTAUA(JK, JSW) = ZTAUA(JK, JSW) + RSRTAUA(JSW, JAE) * PAER(JL, JAE, IK)
     295              ZOMGA(JK, JSW) = ZOMGA(JK, JSW) + RSRTAUA(JSW, JAE) * PAER(JL, JAE, IK) &
     296                      & * RSRPIZA(JSW, JAE)
     297              ZASYA(JK, JSW) = ZASYA(JK, JSW) + RSRTAUA(JSW, JAE) * PAER(JL, JAE, IK) &
     298                      & * RSRPIZA(JSW, JAE) * RSRASYA(JSW, JAE)
     299            ENDDO
     300            IF (ZOMGA(JK, JSW) /= 0.0_JPRB) THEN
     301              ZASYA(JK, JSW) = ZASYA(JK, JSW) / ZOMGA(JK, JSW)
     302            ENDIF
     303            IF (ZTAUA(JK, JSW) /= 0.0_JPRB) THEN
     304              ZOMGA(JK, JSW) = ZOMGA(JK, JSW) / ZTAUA(JK, JSW)
     305            ENDIF
     306            !      print 9003,JSW,JK,ZTAUA(JK,JSW),ZOMGA(JK,JSW),ZASYA(JK,JSW)
     307            9003  format(1x, 'Aerosols ', 2I3, 3F10.4)
     308          ENDDO
     309        ENDDO
     310      ENDIF
     311
     312      DO JK = 1, KLEV + 1
     313        ZBBCU(JK) = 0.0_JPRB
     314        ZBBCD(JK) = 0.0_JPRB
     315        ZBBFU(JK) = 0.0_JPRB
     316        ZBBFD(JK) = 0.0_JPRB
     317        !      ZUVCU(JK)=0.0_JPRB
     318        !      ZUVCD(JK)=0.0_JPRB
     319        !      ZUVFU(JK)=0.0_JPRB
     320        !      ZUVFD(JK)=0.0_JPRB
     321        !      ZVSCU(JK)=0.0_JPRB
     322        !      ZVSCD(JK)=0.0_JPRB
     323        !      ZVSFU(JK)=0.0_JPRB
     324        !      ZVSFD(JK)=0.0_JPRB
     325        !      ZNICU(JK)=0.0_JPRB
     326        !      ZNICD(JK)=0.0_JPRB
     327        !      ZNIFU(JK)=0.0_JPRB
     328        !      ZNIFD(JK)=0.0_JPRB
     329      ENDDO
     330
     331      !    print *,'just before calling STRM_SPCVRT for JL=',JL,' and ZRMU0=',ZRMU0
     332
     333      CALL SRTM_SPCVRT_MCICA &
     334              &(KLEV, ITMOL, KSW, KCOLS, ZONEMINUS, &
     335              & ZPAVEL, ZTAVEL, ZPZ, ZTZ, ZTBOUND, ZALBD, ZALBP, &
     336              & ZFRCL, ZTAUC, ZASYC, ZOMGC, ZTAUA, ZASYA, ZOMGA, ZRMU0, &
     337              & ZCOLDRY, ZWKL, &
     338              & ILAYTROP, ILAYSWTCH, ILAYLOW, &
     339              & ZCO2MULT, ZCOLCH4, ZCOLCO2, ZCOLH2O, ZCOLMOL, ZCOLN2O, ZCOLO2, ZCOLO3, &
     340              & ZFORFAC, ZFORFRAC, INDFOR, ZSELFFAC, ZSELFFRAC, INDSELF, &
     341              & ZFAC00, ZFAC01, ZFAC10, ZFAC11, &
     342              & JP, JT, JT1, &
     343              & ZBBFD, ZBBFU, ZBBCD, ZBBCU)
     344
     345      !     & ZBBFD   , ZBBFU    , ZUVFD  , ZUVFU  , ZVSFD   , ZVSFU   , ZNIFD , ZNIFU,&
     346      !     & ZBBCD   , ZBBCU    , ZUVCD  , ZUVCU  , ZVSCD   , ZVSCU   , ZNICD , ZNICU &
     347      !     & )
     348
     349      !  print *,'SRTM_SRTM_224GP before potential scaling'
     350      !    IF (IOVLP == 3) THEN
     351      !      DO JK=1,KLEV+1
     352      !!      print 9004,JK,ZBBCU(JK),ZBBCD(JK),ZBBFU(JK),ZBBFD(JK)
     353      9004 format(1x, 'Clear-sky and total fluxes U & D ', I3, 4F10.3)
     354      !        PFSUC(JL,1,JK)=ZBBCU(JK)
     355      !        PFSUC(JL,2,JK)=ZBBCD(JK)
     356      !        PFSUX(JL,1,JK)=ZBBFU(JK)
     357      !        PFSUX(JL,2,JK)=ZBBFD(JK)
     358      !      ENDDO
     359      !    ELSE
     360      !    print *,'SRTM_SRTM_224GP after potential scaling'
     361      DO JK = 1, KLEV + 1
     362        PFSUC(JL, 1, JK) = ZADJI0 * ZBBCU(JK)
     363        PFSUC(JL, 2, JK) = ZADJI0 * ZBBCD(JK)
     364        PFSUX(JL, 1, JK) = ZADJI0 * ((1.0_JPRB - ZCLEAR) * ZBBFU(JK) + ZCLEAR * ZBBCU(JK))
     365        PFSUX(JL, 2, JK) = ZADJI0 * ((1.0_JPRB - ZCLEAR) * ZBBFD(JK) + ZCLEAR * ZBBCD(JK))
     366        !-- for testing only
     367        PFSUC(JL, 1, JK) = ZADJI0 * ZBBCU(JK)
     368        PFSUC(JL, 2, JK) = ZADJI0 * ZBBCD(JK)
     369        PFSUX(JL, 1, JK) = ZADJI0 * ZBBFU(JK)
     370        PFSUX(JL, 2, JK) = ZADJI0 * ZBBFD(JK)
     371      ENDDO
     372      !    ENDIF
     373
     374      !  DO JK=1,KLEV+1
     375      !    print 9005,JK,PFSUC(JL,1,JK),PFSUC(JL,2,JK),PFSUX(JL,1,JK),PFSUX(JL,2,JK)
     376      9005 format(1x, 'Clear-sky and total fluxes U & D ', I3, 4F10.3)
     377      !  ENDDO
     378
    290379    ELSE
    291       DO JSW=1,KSW
    292         DO JK=1,KLEV
    293           IK=KLEV+1-JK
    294           ZTAUA(JK,JSW)=0.0_JPRB
    295           ZASYA(JK,JSW)=0.0_JPRB
    296           ZOMGA(JK,JSW)=0.0_JPRB
    297           DO JAE=1,6
    298             ZTAUA(JK,JSW)=ZTAUA(JK,JSW)+RSRTAUA(JSW,JAE)*PAER(JL,JAE,IK)
    299             ZOMGA(JK,JSW)=ZOMGA(JK,JSW)+RSRTAUA(JSW,JAE)*PAER(JL,JAE,IK) &
    300              & *RSRPIZA(JSW,JAE) 
    301             ZASYA(JK,JSW)=ZASYA(JK,JSW)+RSRTAUA(JSW,JAE)*PAER(JL,JAE,IK) &
    302              & *RSRPIZA(JSW,JAE)*RSRASYA(JSW,JAE) 
    303           ENDDO
    304           IF (ZOMGA(JK,JSW) /= 0.0_JPRB) THEN
    305             ZASYA(JK,JSW)=ZASYA(JK,JSW)/ZOMGA(JK,JSW)
    306           ENDIF
    307           IF (ZTAUA(JK,JSW) /= 0.0_JPRB) THEN
    308             ZOMGA(JK,JSW)=ZOMGA(JK,JSW)/ZTAUA(JK,JSW)
    309           ENDIF
    310 !      print 9003,JSW,JK,ZTAUA(JK,JSW),ZOMGA(JK,JSW),ZASYA(JK,JSW)
    311 9003  format(1x,'Aerosols ',2I3,3F10.4)
    312         ENDDO
     380      DO JK = 1, KLEV + 1
     381        PFSUC(JL, 1, JK) = 0.0_JPRB
     382        PFSUC(JL, 2, JK) = 0.0_JPRB
     383        PFSUX(JL, 1, JK) = 0.0_JPRB
     384        PFSUX(JL, 2, JK) = 0.0_JPRB
    313385      ENDDO
    314386    ENDIF
    315 
    316     DO JK=1,KLEV+1
    317       ZBBCU(JK)=0.0_JPRB
    318       ZBBCD(JK)=0.0_JPRB
    319       ZBBFU(JK)=0.0_JPRB
    320       ZBBFD(JK)=0.0_JPRB
    321 !      ZUVCU(JK)=0.0_JPRB
    322 !      ZUVCD(JK)=0.0_JPRB
    323 !      ZUVFU(JK)=0.0_JPRB
    324 !      ZUVFD(JK)=0.0_JPRB
    325 !      ZVSCU(JK)=0.0_JPRB
    326 !      ZVSCD(JK)=0.0_JPRB
    327 !      ZVSFU(JK)=0.0_JPRB
    328 !      ZVSFD(JK)=0.0_JPRB
    329 !      ZNICU(JK)=0.0_JPRB
    330 !      ZNICD(JK)=0.0_JPRB
    331 !      ZNIFU(JK)=0.0_JPRB
    332 !      ZNIFD(JK)=0.0_JPRB
    333     ENDDO
    334 
    335 !    print *,'just before calling STRM_SPCVRT for JL=',JL,' and ZRMU0=',ZRMU0
    336 
    337     CALL SRTM_SPCVRT_MCICA &
    338      &( KLEV   , ITMOL    , KSW    , KCOLS  , ZONEMINUS,&
    339      & ZPAVEL  , ZTAVEL   , ZPZ    , ZTZ    , ZTBOUND , ZALBD   , ZALBP,&
    340      & ZFRCL   , ZTAUC    , ZASYC  , ZOMGC  , ZTAUA   , ZASYA   , ZOMGA , ZRMU0,&
    341      & ZCOLDRY , ZWKL     ,&
    342      & ILAYTROP, ILAYSWTCH, ILAYLOW,&
    343      & ZCO2MULT, ZCOLCH4  , ZCOLCO2, ZCOLH2O , ZCOLMOL  , ZCOLN2O, ZCOLO2 , ZCOLO3,&
    344      & ZFORFAC , ZFORFRAC , INDFOR , ZSELFFAC, ZSELFFRAC, INDSELF,&
    345      & ZFAC00  , ZFAC01   , ZFAC10 , ZFAC11  ,&
    346      & JP      , JT       , JT1    ,&
    347      & ZBBFD   , ZBBFU    , ZBBCD  , ZBBCU )
    348      
    349 !     & ZBBFD   , ZBBFU    , ZUVFD  , ZUVFU  , ZVSFD   , ZVSFU   , ZNIFD , ZNIFU,&
    350 !     & ZBBCD   , ZBBCU    , ZUVCD  , ZUVCU  , ZVSCD   , ZVSCU   , ZNICD , ZNICU &
    351 !     & ) 
    352 
    353 !  print *,'SRTM_SRTM_224GP before potential scaling'
    354 !    IF (IOVLP == 3) THEN
    355 !      DO JK=1,KLEV+1
    356 !!      print 9004,JK,ZBBCU(JK),ZBBCD(JK),ZBBFU(JK),ZBBFD(JK)
    357         9004 format(1x,'Clear-sky and total fluxes U & D ',I3,4F10.3)
    358 !        PFSUC(JL,1,JK)=ZBBCU(JK)
    359 !        PFSUC(JL,2,JK)=ZBBCD(JK)
    360 !        PFSUX(JL,1,JK)=ZBBFU(JK)
    361 !        PFSUX(JL,2,JK)=ZBBFD(JK)
    362 !      ENDDO
    363 !    ELSE
    364 !    print *,'SRTM_SRTM_224GP after potential scaling'
    365       DO JK=1,KLEV+1
    366         PFSUC(JL,1,JK)=ZADJI0 * ZBBCU(JK)
    367         PFSUC(JL,2,JK)=ZADJI0 * ZBBCD(JK)
    368         PFSUX(JL,1,JK)=ZADJI0 * ( (1.0_JPRB-ZCLEAR)*ZBBFU(JK)+ZCLEAR*ZBBCU(JK) )
    369         PFSUX(JL,2,JK)=ZADJI0 * ( (1.0_JPRB-ZCLEAR)*ZBBFD(JK)+ZCLEAR*ZBBCD(JK) )
    370 !-- for testing only
    371         PFSUC(JL,1,JK)=ZADJI0 * ZBBCU(JK)
    372         PFSUC(JL,2,JK)=ZADJI0 * ZBBCD(JK)
    373         PFSUX(JL,1,JK)=ZADJI0 * ZBBFU(JK)
    374         PFSUX(JL,2,JK)=ZADJI0 * ZBBFD(JK)
    375       ENDDO
    376 !    ENDIF
    377 
    378 !  DO JK=1,KLEV+1
    379 !    print 9005,JK,PFSUC(JL,1,JK),PFSUC(JL,2,JK),PFSUX(JL,1,JK),PFSUX(JL,2,JK)
    380     9005 format(1x,'Clear-sky and total fluxes U & D ',I3,4F10.3)
    381 !  ENDDO
    382  
    383   ELSE
    384     DO JK=1,KLEV+1
    385       PFSUC(JL,1,JK)=0.0_JPRB
    386       PFSUC(JL,2,JK)=0.0_JPRB
    387       PFSUX(JL,1,JK)=0.0_JPRB
    388       PFSUX(JL,2,JK)=0.0_JPRB
    389     ENDDO
    390   ENDIF
    391 ENDDO
    392 
    393 !PRINT *,'OUT OF SRTM_224GP_MCICA'
    394 
    395 !-----------------------------------------------------------------------
    396 IF (LHOOK) CALL DR_HOOK('SRTM_SRTM_224GP_MCICA',1,ZHOOK_HANDLE)
     387  ENDDO
     388
     389  !PRINT *,'OUT OF SRTM_224GP_MCICA'
     390
     391  !-----------------------------------------------------------------------
     392  IF (LHOOK) CALL DR_HOOK('SRTM_SRTM_224GP_MCICA', 1, ZHOOK_HANDLE)
    397393END SUBROUTINE SRTM_SRTM_224GP_MCICA

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/suecrad.F90

    r5133 r5154  
    22! $Id: suecrad.F90 4251 2022-09-20 00:22:43Z fhourdin $
    33!
    4 SUBROUTINE SUECRAD (KULOUT, KLEV, PETAH )
    5 
    6 !**** *SUECRAD*   - INITIALIZE COMMONS YOERxx CONTROLLING RADIATION
    7 
    8 !     PURPOSE.
    9 !     --------
    10 !           INITIALIZE YOERAD, THE COMMON THAT CONTROLS THE
    11 !           RADIATION OF THE MODEL, AND YOERDU THAT INCLUDES
    12 !           ADJUSTABLE PARAMETERS FOR RADIATION COMPUTATIONS
    13 
    14 !**   INTERFACE.
    15 !     ----------
    16 !        CALL *SUECRAD* FROM *SUPHEC*
    17 !              -------        ------
    18 
    19 !        EXPLICIT ARGUMENTS :
    20 !        --------------------
    21 !        NONE
    22 
    23 !        IMPLICIT ARGUMENTS :
    24 !        --------------------
    25 !        COMMONS YOERAD, YOERDU
    26 
    27 !     METHOD.
    28 !     -------
    29 !        SEE DOCUMENTATION
    30 
    31 !     EXTERNALS.
    32 !     ----------
    33 !        SUAER, SUAERH, SUAERV, SULW, SUSW, SUOCST, SUSAT
    34 !        SUAERL, SUAERSN, SUSRTAER, SRTM_INIT, SUSRTCOP
    35 
    36 !     REFERENCE.
    37 !     ----------
    38 !        ECMWF Research Department documentation of the IFS
    39 
    40 !     AUTHOR.
    41 !     -------
    42 !        JEAN-JACQUES MORCRETTE  *ECMWF*
    43 
    44 !     MODIFICATIONS.
    45 !     --------------
    46 !        ORIGINAL : 88-12-15
    47 !        P.COURTIER AND M.HAMRUD NAME SURAD ALREADY USED
    48 !        Modified 93-11-15 by Ph. Dandin : FMR scheme with MF
    49 !        Modified 95-12 by PhD : Cloud overlapping hypothesis for FMR
    50 !        980317 JJMorcrette clean-up (NRAD, NFLUX)
    51 !        000118 JJMorcrette variable concentr. uniformly mixed gases
    52 !        990525 JJMorcrette GISS volcanic and new tropospheric aerosols
    53 !        990831 JJMorcrette RRTM
    54 !        R. El Khatib 01-02-02 proper initialization of NFRRC moved in SUCFU
    55 !        010129 JJMorcrette clean-up LERAD1H, NLNGR1H
    56 !        011105 GMozdzynski support new radiation grid
    57 !        011005 JJMorcrette CCN --> Re Water clouds
    58 !        R. El Khatib 01-02-02 LRRTM=lecmwf by default
    59 !        020909 GMozdzynski support NRADRES to specify radiation grid
    60 !        021001 GMozdzynski support on-demand radiation communications
    61 !        030422 GMozdzynski automatic min-halo
    62 !        030501 JJMorcrette new radiation grid on, new aerosols on (default)
    63 !        030513 JJMorcrette progn. O3 / radiation interactions off (default)
    64 !        M.Hamrud      01-Oct-2003 CY28 Cleaning
    65 !        050315 JJMorcrette prog.aerosols v1
    66 !        041214 JJMorcrette SRTM
    67 !        050111 JJMorcrette new cloud optical properties
    68 !        050415 GMozdzynski Reduced halo support for radiation interpolation
    69 !        051004 JJMorcrette UV surface radiation processor
    70 !        051220 JJMorcrette SRTM112g+LWSCAT+UVprocessor+(bgfx:swclr, radaca)
    71 !        060510 JJMorcrette MODIS albedo (UVis, NIR)x(parallel+diffuse)
    72 !        060510 JJMorcrette MODIS albedo (UVis, NIR)x(parallel+diffuse)
    73 !        JJMorcrette 20060721 PP of clear-sky PAR and TOA incident solar radiation
    74 !        060625 JJMorcrette MODIS albedo (UVis, NIR)x(parallel+diffuse)
    75 !        060726 JJMorcrette McICA default operational configuration
    76 !     ------------------------------------------------------------------
    77 
    78 USE PARKIND1  ,ONLY : JPIM     ,JPRB
    79 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
    80 
    81 USE PARDIM   , ONLY : JPMXGL
    82 USE PARRRTM  , ONLY : JPLAY
    83 USE PARSRTM  , ONLY : JPGPT
    84 USE YOMCT0   , ONLY : LOUTPUT  ,NPRINTLEV,LALLOPR,&
    85  & NPROC    ,N_REGIONS_NS  ,N_REGIONS_EW
    86 USE YOMDIM   , ONLY : NDLON    ,NSMAX    ,NDGENL    ,&
    87  & NDGSAL   ,NDGLG    ,NDGSAG   ,NDGENG   ,NDSUR1    ,&
    88  & NDLSUR   ,NDGSUR   ,NGPBLKS  ,NFLEVG   ,NPROMA 
    89 USE YOMCT0B  , ONLY : LECMWF
    90 USE YOMDYN   , ONLY : TSTEP
    91 ! Ce qui concerne NULRAD commente par MPL le 15.04.09
    92 !USE YOMLUN   , ONLY : NULNAM   ,NULRAD   ,NULOUT
    93 USE YOMLUN   , ONLY : NULRAD   ,NULOUT
    94 USE YOMCST   , ONLY : RDAY     ,RG       ,RCPD     ,RPI     ,RI0
    95 USE YOMPHY   , ONLY : LMPHYS, LRAYFM   ,LRAYFM15
    96 USE YOEPHY   , ONLY : LEPHYS   ,LERADI, LE4ALB
    97 USE YOERDI   , ONLY : RCCO2, RCCH4, RCN2O, RCCFC11, RCCFC12, RSOLINC
    98 USE YOERAD   , ONLY : NAER     , NOZOCL   ,&
    99  & NRADFR   ,NRADPFR  ,NRADPLA  ,NRINT    ,&
    100  & NRADNFR  ,NRADSFR  ,NOVLP    ,NRPROMA  ,&
    101 !& NLW      ,NSW      ,NTSW     ,NCSRADF  ,&
    102 ! NSW mis dans .def MPL 20140211
    103  & NLW      ,NTSW     ,NCSRADF  ,&
    104  & NMODE    ,NLNGR1H  ,NSWNL    ,NSWTL    ,NUV     ,&
    105  & LERAD1H  ,LERADHS  ,LEPO3RA  ,LRADLB   ,LONEWSW ,&
    106  & LCCNL    ,LCCNO    ,&
    107  & LECSRAD  ,LHVOLCA  ,LNEWAER  ,LRRTM    ,LSRTM   ,LDIFFC  ,&
    108  & NRADINT  ,NRADRES  ,CRTABLEDIR,CRTABLEFIL       ,&
    109  & NICEOPT  ,NLIQOPT  ,NRADIP   ,NRADLP   ,NINHOM  ,NLAYINH ,&
    110  & LRAYL    ,LOPTRPROMA,&
    111  & RCCNLND  ,RCCNSEA  ,RLWINHF  ,RSWINHF  ,RRe2De  ,&
    112  & RPERTOZ  ,NPERTOZ  ,NMCICA   ,&
    113  & LNOTROAER,NPERTAER ,LECO2VAR ,LHGHG    ,NHINCSOL,NSCEN ,&
    114  & LEDBUG
    115 USE YOERDU   , ONLY : NUAER    ,NTRAER   ,RCDAY    ,R10E     ,&
    116  & REPLOG   ,REPSC    ,REPSCO   ,REPSCQ   ,REPSCT   ,&
    117  & REPSCW   ,DIFF 
    118 USE YOEAERD  , ONLY : CVDAES   ,CVDAEL   ,CVDAEU   ,CVDAED   ,&
    119  & RCAEOPS  ,RCAEOPL  ,RCAEOPU  ,RCAEOPD  ,RCTRBGA  ,&
    120  & RCVOBGA  ,RCSTBGA  ,RCTRPT   ,RCAEADM  ,RCAEROS  ,            &
    121  & RCAEADK 
    122 USE YOE_UVRAD, ONLY : JUVLAM, LUVPROC, LUVTDEP, LUVDBG, NRADUV, NUVTIM, RUVLAM, RMUZUV
    123 
    124 USE YOMMP    , ONLY : MYPROC   ,NPRCIDS  ,LSPLIT   ,NAPSETS  ,&
    125  & NPTRFLOFF,NFRSTLOFF,MYFRSTACTLAT,MYLSTACTLAT,&
    126  & NSTA,NONL,NPTRFRSTLAT,NFRSTLAT,NLSTLAT ,&
    127  & MY_REGION_NS  ,MY_REGION_EW   ,NGLOBALINDEX ,&
    128  & NRISTA  ,NRIONL   ,NRIOFF    ,NRIEXT   ,NRICORE ,&
    129  & NRISENDPOS ,NRIRECVPOS ,NRISENDPTR ,NRIRECVPTR ,&
    130  & NARIB1  ,NRIPROCS ,NRIMPBUFSZ,NRISPT   ,NRIRPT ,&
    131  & NRICOMM ,&
    132  & NROSTA  ,NROONL   ,NROOFF    ,NROEXT   ,NROCORE ,&
    133  & NROSENDPOS ,NRORECVPOS ,NROSENDPTR ,NRORECVPTR ,&
    134  & NAROB1  ,NROPROCS ,NROMPBUFSZ,NROSPT   ,NRORPT ,&
    135  & NROCOMM
    136 USE YOMGC    , ONLY : GELAT    ,GELAM
    137 USE YOMLEG   , ONLY : RMU      ,RSQM2
    138 USE YOMSC2   , ONLY : &
    139  & NRIWIDEN  ,NRIWIDES  ,NRIWIDEW  ,NRIWIDEE,&
    140  & NROWIDEN  ,NROWIDES  ,NROWIDEW  ,NROWIDEE
    141 USE YOMGEM   , ONLY : NGPTOT   ,NGPTOTG   ,NGPTOTMX ,NLOENG
    142 USE YOMTAG   , ONLY : MTAGRAD
    143 USE YOMPRAD  , ONLY : LODBGRADI,LODBGRADL ,RADGRID  ,&
    144  & LRADONDEM 
    145 USE YOMRADF  , ONLY : EMTD     ,TRSW     ,EMTC      ,TRSC    ,&
    146  & SRSWD    ,SRLWD    ,SRSWDCS  ,SRLWDCS   ,SRSWDV  ,&
    147  & SRSWDUV  ,EDRO     ,SRSWPAR  ,SRSWUVB   ,SRSWPARC,  SRSWTINC,&
    148  & EMTU, RMOON
    149 ! Commente par MPL 26.11.08
    150 !USE YOPHNC   , ONLY :  LERADN2
    151 ! MPLefebvre 6-11-08 commente tout ce qui concerne MPL_MODULE
    152 !USE MPL_MODULE  , ONLY :  MPL_BROADCAST, MPL_SEND, MPL_RECV
    153 USE YOM_YGFL , ONLY : YO3
    154 !!!!! A REVOIR (MPL) NDLNPR devrait etre initialise dans sudyn.F90
    155 USE YOMDYN   , ONLY : NDLNPR
    156 
    157 IMPLICIT NONE
    158 
    159 INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
    160 INTEGER(KIND=JPIM),INTENT(IN)    :: KULOUT
    161 REAL(KIND=JPRB)   ,INTENT(IN)    :: PETAH(KLEV+1)
    162 !     LOCAL ARRAYS FOR THE PURPOSE OF READING NAMRGRI (RADIATION GRID)
    163 INTEGER(KIND=JPIM) :: NRGRI(JPMXGL)
    164 
    165 INTEGER(KIND=JPIM) :: IDGL,INBLW,IRADFR,IST1HR,ISTNHR,IDIR,IFIL
    166 INTEGER(KIND=JPIM) :: IRIRPTSUR,IRISPTSUR,IRIMAPLEN
    167 INTEGER(KIND=JPIM) :: JLON,JGLAT,JGL,JGLSUR,IDLSUR,IOFF,ILAT,ISTLON,IENDLON
    168 INTEGER(KIND=JPIM) :: IRORPTSUR,IROSPTSUR,IROMAPLEN
    169 INTEGER(KIND=JPIM) :: ILBRLATI,IUBRLATI,IGLGLO,IDUM,IU
    170 INTEGER(KIND=JPIM) :: J,JROC,IGPTOT
    171 INTEGER(KIND=JPIM) :: IROWIDEMAXN,IROWIDEMAXS,IROWIDEMAXW,IROWIDEMAXE
    172 INTEGER(KIND=JPIM) :: IRIWIDEMAXN,IRIWIDEMAXS,IRIWIDEMAXW,IRIWIDEMAXE
    173 INTEGER(KIND=JPIM) :: IARIB1MAX,IAROB1MAX
    174 INTEGER(KIND=JPIM) :: IWIDE(10)
    175 INTEGER(KIND=JPIM) :: ILATS_DIFF_F,ILATS_DIFF_C
    176 INTEGER(KIND=JPIM), PARAMETER :: JP_MIN_HALO=5
    177 INTEGER(KIND=JPIM) :: ISW,JUV,IDAYUV
    178 
    179 LOGICAL :: LLINEAR_GRID
    180 LOGICAL :: LLDEBUG,LLP
    181 
    182 REAL(KIND=JPRB) :: ZSTPHR, ZTSTEP, ZGEMU, ZLON, ZD1, ZD2, ZD3, ZD4, ZD5, ZD6
    183 REAL(KIND=JPRB) :: ZMINRADLAT,ZMAXRADLAT,ZMINRADLON,ZMAXRADLON
    184 REAL(KIND=JPRB) :: ZMINMDLLAT,ZMAXMDLLAT,ZMINMDLLON,ZMAXMDLLON
    185 REAL(KIND=JPRB) :: ZLAT
    186 !REAL(KIND=JPRB) :: RLATVOL, RLONVOL
    187 
    188 CHARACTER (LEN = 300) ::  CLFN
    189 INTEGER(KIND=JPIM), PARAMETER :: JPIOMASTER=1
    190 
    191 INTEGER(KIND=JPIM), ALLOCATABLE :: IRISENDPOS(:)
    192 INTEGER(KIND=JPIM), ALLOCATABLE :: IRIRECVPOS(:)
    193 INTEGER(KIND=JPIM), ALLOCATABLE :: IRISENDPTR(:)
    194 INTEGER(KIND=JPIM), ALLOCATABLE :: IRIRECVPTR(:)
    195 INTEGER(KIND=JPIM), ALLOCATABLE :: IRICOMM(:)
    196 INTEGER(KIND=JPIM), ALLOCATABLE :: IRIMAP(:,:)
    197 INTEGER(KIND=JPIM), ALLOCATABLE :: IROSENDPOS(:)
    198 INTEGER(KIND=JPIM), ALLOCATABLE :: IRORECVPOS(:)
    199 INTEGER(KIND=JPIM), ALLOCATABLE :: IROSENDPTR(:)
    200 INTEGER(KIND=JPIM), ALLOCATABLE :: IRORECVPTR(:)
    201 INTEGER(KIND=JPIM), ALLOCATABLE :: IROCOMM(:)
    202 INTEGER(KIND=JPIM), ALLOCATABLE :: IROMAP(:,:)
    203 INTEGER(KIND=JPIM), ALLOCATABLE :: IGLOBALINDEX(:)
    204 
    205 REAL(KIND=JPRB),ALLOCATABLE :: ZLATX(:)
    206 REAL(KIND=JPRB),ALLOCATABLE :: ZLONX(:)
    207 REAL(KIND=JPRB) :: ZHOOK_HANDLE
    208 
    209 INTERFACE
     4SUBROUTINE SUECRAD (KULOUT, KLEV, PETAH)
     5
     6  !**** *SUECRAD*   - INITIALIZE COMMONS YOERxx CONTROLLING RADIATION
     7
     8  !     PURPOSE.
     9  !     --------
     10  !           INITIALIZE YOERAD, THE COMMON THAT CONTROLS THE
     11  !           RADIATION OF THE MODEL, AND YOERDU THAT INCLUDES
     12  !           ADJUSTABLE PARAMETERS FOR RADIATION COMPUTATIONS
     13
     14  !**   INTERFACE.
     15  !     ----------
     16  !        CALL *SUECRAD* FROM *SUPHEC*
     17  !              -------        ------
     18
     19  !        EXPLICIT ARGUMENTS :
     20  !        --------------------
     21  !        NONE
     22
     23  !        IMPLICIT ARGUMENTS :
     24  !        --------------------
     25  !        COMMONS YOERAD, YOERDU
     26
     27  !     METHOD.
     28  !     -------
     29  !        SEE DOCUMENTATION
     30
     31  !     EXTERNALS.
     32  !     ----------
     33  !        SUAER, SUAERH, SUAERV, SULW, SUSW, SUOCST, SUSAT
     34  !        SUAERL, SUAERSN, SUSRTAER, SRTM_INIT, SUSRTCOP
     35
     36  !     REFERENCE.
     37  !     ----------
     38  !        ECMWF Research Department documentation of the IFS
     39
     40  !     AUTHOR.
     41  !     -------
     42  !        JEAN-JACQUES MORCRETTE  *ECMWF*
     43
     44  !     MODIFICATIONS.
     45  !     --------------
     46  !        ORIGINAL : 88-12-15
     47  !        P.COURTIER AND M.HAMRUD NAME SURAD ALREADY USED
     48  !        Modified 93-11-15 by Ph. Dandin : FMR scheme with MF
     49  !        Modified 95-12 by PhD : Cloud overlapping hypothesis for FMR
     50  !        980317 JJMorcrette clean-up (NRAD, NFLUX)
     51  !        000118 JJMorcrette variable concentr. uniformly mixed gases
     52  !        990525 JJMorcrette GISS volcanic and new tropospheric aerosols
     53  !        990831 JJMorcrette RRTM
     54  !        R. El Khatib 01-02-02 proper initialization of NFRRC moved in SUCFU
     55  !        010129 JJMorcrette clean-up LERAD1H, NLNGR1H
     56  !        011105 GMozdzynski support new radiation grid
     57  !        011005 JJMorcrette CCN --> Re Water clouds
     58  !        R. El Khatib 01-02-02 LRRTM=lecmwf by default
     59  !        020909 GMozdzynski support NRADRES to specify radiation grid
     60  !        021001 GMozdzynski support on-demand radiation communications
     61  !        030422 GMozdzynski automatic min-halo
     62  !        030501 JJMorcrette new radiation grid on, new aerosols on (default)
     63  !        030513 JJMorcrette progn. O3 / radiation interactions off (default)
     64  !        M.Hamrud      01-Oct-2003 CY28 Cleaning
     65  !        050315 JJMorcrette prog.aerosols v1
     66  !        041214 JJMorcrette SRTM
     67  !        050111 JJMorcrette new cloud optical properties
     68  !        050415 GMozdzynski Reduced halo support for radiation interpolation
     69  !        051004 JJMorcrette UV surface radiation processor
     70  !        051220 JJMorcrette SRTM112g+LWSCAT+UVprocessor+(bgfx:swclr, radaca)
     71  !        060510 JJMorcrette MODIS albedo (UVis, NIR)x(parallel+diffuse)
     72  !        060510 JJMorcrette MODIS albedo (UVis, NIR)x(parallel+diffuse)
     73  !        JJMorcrette 20060721 PP of clear-sky PAR and TOA incident solar radiation
     74  !        060625 JJMorcrette MODIS albedo (UVis, NIR)x(parallel+diffuse)
     75  !        060726 JJMorcrette McICA default operational configuration
     76  !     ------------------------------------------------------------------
     77
     78  USE PARKIND1, ONLY: JPIM, JPRB
     79  USE YOMHOOK, ONLY: LHOOK, DR_HOOK
     80
     81  USE PARDIM, ONLY: JPMXGL
     82  USE PARRRTM, ONLY: JPLAY
     83  USE PARSRTM, ONLY: JPGPT
     84  USE YOMCT0, ONLY: LOUTPUT, NPRINTLEV, LALLOPR, &
     85          & NPROC, N_REGIONS_NS, N_REGIONS_EW
     86  USE YOMDIM, ONLY: NDLON, NSMAX, NDGENL, &
     87          & NDGSAL, NDGLG, NDGSAG, NDGENG, NDSUR1, &
     88          & NDLSUR, NDGSUR, NGPBLKS, NFLEVG, NPROMA
     89  USE YOMCT0B, ONLY: LECMWF
     90  USE YOMDYN, ONLY: TSTEP
     91  ! Ce qui concerne NULRAD commente par MPL le 15.04.09
     92  !USE YOMLUN   , ONLY : NULNAM   ,NULRAD   ,NULOUT
     93  USE YOMLUN, ONLY: NULRAD, NULOUT
     94  USE YOMCST, ONLY: RDAY, RG, RCPD, RPI, RI0
     95  USE YOMPHY, ONLY: LMPHYS, LRAYFM, LRAYFM15
     96  USE YOEPHY, ONLY: LEPHYS, LERADI, LE4ALB
     97  USE YOERDI, ONLY: RCCO2, RCCH4, RCN2O, RCCFC11, RCCFC12, RSOLINC
     98  USE YOERAD, ONLY: NAER, NOZOCL, &
     99          & NRADFR, NRADPFR, NRADPLA, NRINT, &
     100          & NRADNFR, NRADSFR, NOVLP, NRPROMA, &
     101          !& NLW      ,NSW      ,NTSW     ,NCSRADF  ,&
     102          ! NSW mis dans .def MPL 20140211
     103          & NLW, NTSW, NCSRADF, &
     104          & NMODE, NLNGR1H, NSWNL, NSWTL, NUV, &
     105          & LERAD1H, LERADHS, LEPO3RA, LRADLB, LONEWSW, &
     106          & LCCNL, LCCNO, &
     107          & LECSRAD, LHVOLCA, LNEWAER, LRRTM, LSRTM, LDIFFC, &
     108          & NRADINT, NRADRES, CRTABLEDIR, CRTABLEFIL, &
     109          & NICEOPT, NLIQOPT, NRADIP, NRADLP, NINHOM, NLAYINH, &
     110          & LRAYL, LOPTRPROMA, &
     111          & RCCNLND, RCCNSEA, RLWINHF, RSWINHF, RRe2De, &
     112          & RPERTOZ, NPERTOZ, NMCICA, &
     113          & LNOTROAER, NPERTAER, LECO2VAR, LHGHG, NHINCSOL, NSCEN, &
     114          & LEDBUG
     115  USE YOERDU, ONLY: NUAER, NTRAER, RCDAY, R10E, &
     116          & REPLOG, REPSC, REPSCO, REPSCQ, REPSCT, &
     117          & REPSCW, DIFF
     118  USE YOEAERD, ONLY: CVDAES, CVDAEL, CVDAEU, CVDAED, &
     119          & RCAEOPS, RCAEOPL, RCAEOPU, RCAEOPD, RCTRBGA, &
     120          & RCVOBGA, RCSTBGA, RCTRPT, RCAEADM, RCAEROS, &
     121          & RCAEADK
     122  USE YOE_UVRAD, ONLY: JUVLAM, LUVPROC, LUVTDEP, LUVDBG, NRADUV, NUVTIM, RUVLAM, RMUZUV
     123
     124  USE YOMMP, ONLY: MYPROC, NPRCIDS, LSPLIT, NAPSETS, &
     125          & NPTRFLOFF, NFRSTLOFF, MYFRSTACTLAT, MYLSTACTLAT, &
     126          & NSTA, NONL, NPTRFRSTLAT, NFRSTLAT, NLSTLAT, &
     127          & MY_REGION_NS, MY_REGION_EW, NGLOBALINDEX, &
     128          & NRISTA, NRIONL, NRIOFF, NRIEXT, NRICORE, &
     129          & NRISENDPOS, NRIRECVPOS, NRISENDPTR, NRIRECVPTR, &
     130          & NARIB1, NRIPROCS, NRIMPBUFSZ, NRISPT, NRIRPT, &
     131          & NRICOMM, &
     132          & NROSTA, NROONL, NROOFF, NROEXT, NROCORE, &
     133          & NROSENDPOS, NRORECVPOS, NROSENDPTR, NRORECVPTR, &
     134          & NAROB1, NROPROCS, NROMPBUFSZ, NROSPT, NRORPT, &
     135          & NROCOMM
     136  USE YOMGC, ONLY: GELAT, GELAM
     137  USE YOMLEG, ONLY: RMU, RSQM2
     138  USE YOMSC2, ONLY: &
     139          & NRIWIDEN, NRIWIDES, NRIWIDEW, NRIWIDEE, &
     140          & NROWIDEN, NROWIDES, NROWIDEW, NROWIDEE
     141  USE YOMGEM, ONLY: NGPTOT, NGPTOTG, NGPTOTMX, NLOENG
     142  USE YOMTAG, ONLY: MTAGRAD
     143  USE YOMPRAD, ONLY: LODBGRADI, LODBGRADL, RADGRID, &
     144          & LRADONDEM
     145  USE YOMRADF, ONLY: EMTD, TRSW, EMTC, TRSC, &
     146          & SRSWD, SRLWD, SRSWDCS, SRLWDCS, SRSWDV, &
     147          & SRSWDUV, EDRO, SRSWPAR, SRSWUVB, SRSWPARC, SRSWTINC, &
     148          & EMTU, RMOON
     149  ! Commente par MPL 26.11.08
     150  !USE YOPHNC   , ONLY :  LERADN2
     151  ! MPLefebvre 6-11-08 commente tout ce qui concerne MPL_MODULE
     152  !USE MPL_MODULE  , ONLY :  MPL_BROADCAST, MPL_SEND, MPL_RECV
     153  USE YOM_YGFL, ONLY: YO3
     154  !!!!! A REVOIR (MPL) NDLNPR devrait etre initialise dans sudyn.F90
     155  USE YOMDYN, ONLY: NDLNPR
     156  USE lmdz_clesphys
     157
     158  IMPLICIT NONE
     159
     160  INTEGER(KIND = JPIM), INTENT(IN) :: KLEV
     161  INTEGER(KIND = JPIM), INTENT(IN) :: KULOUT
     162  REAL(KIND = JPRB), INTENT(IN) :: PETAH(KLEV + 1)
     163  !     LOCAL ARRAYS FOR THE PURPOSE OF READING NAMRGRI (RADIATION GRID)
     164  INTEGER(KIND = JPIM) :: NRGRI(JPMXGL)
     165
     166  INTEGER(KIND = JPIM) :: IDGL, INBLW, IRADFR, IST1HR, ISTNHR, IDIR, IFIL
     167  INTEGER(KIND = JPIM) :: IRIRPTSUR, IRISPTSUR, IRIMAPLEN
     168  INTEGER(KIND = JPIM) :: JLON, JGLAT, JGL, JGLSUR, IDLSUR, IOFF, ILAT, ISTLON, IENDLON
     169  INTEGER(KIND = JPIM) :: IRORPTSUR, IROSPTSUR, IROMAPLEN
     170  INTEGER(KIND = JPIM) :: ILBRLATI, IUBRLATI, IGLGLO, IDUM, IU
     171  INTEGER(KIND = JPIM) :: J, JROC, IGPTOT
     172  INTEGER(KIND = JPIM) :: IROWIDEMAXN, IROWIDEMAXS, IROWIDEMAXW, IROWIDEMAXE
     173  INTEGER(KIND = JPIM) :: IRIWIDEMAXN, IRIWIDEMAXS, IRIWIDEMAXW, IRIWIDEMAXE
     174  INTEGER(KIND = JPIM) :: IARIB1MAX, IAROB1MAX
     175  INTEGER(KIND = JPIM) :: IWIDE(10)
     176  INTEGER(KIND = JPIM) :: ILATS_DIFF_F, ILATS_DIFF_C
     177  INTEGER(KIND = JPIM), PARAMETER :: JP_MIN_HALO = 5
     178  INTEGER(KIND = JPIM) :: ISW, JUV, IDAYUV
     179
     180  LOGICAL :: LLINEAR_GRID
     181  LOGICAL :: LLDEBUG, LLP
     182
     183  REAL(KIND = JPRB) :: ZSTPHR, ZTSTEP, ZGEMU, ZLON, ZD1, ZD2, ZD3, ZD4, ZD5, ZD6
     184  REAL(KIND = JPRB) :: ZMINRADLAT, ZMAXRADLAT, ZMINRADLON, ZMAXRADLON
     185  REAL(KIND = JPRB) :: ZMINMDLLAT, ZMAXMDLLAT, ZMINMDLLON, ZMAXMDLLON
     186  REAL(KIND = JPRB) :: ZLAT
     187  !REAL(KIND=JPRB) :: RLATVOL, RLONVOL
     188
     189  CHARACTER (LEN = 300) :: CLFN
     190  INTEGER(KIND = JPIM), PARAMETER :: JPIOMASTER = 1
     191
     192  INTEGER(KIND = JPIM), ALLOCATABLE :: IRISENDPOS(:)
     193  INTEGER(KIND = JPIM), ALLOCATABLE :: IRIRECVPOS(:)
     194  INTEGER(KIND = JPIM), ALLOCATABLE :: IRISENDPTR(:)
     195  INTEGER(KIND = JPIM), ALLOCATABLE :: IRIRECVPTR(:)
     196  INTEGER(KIND = JPIM), ALLOCATABLE :: IRICOMM(:)
     197  INTEGER(KIND = JPIM), ALLOCATABLE :: IRIMAP(:, :)
     198  INTEGER(KIND = JPIM), ALLOCATABLE :: IROSENDPOS(:)
     199  INTEGER(KIND = JPIM), ALLOCATABLE :: IRORECVPOS(:)
     200  INTEGER(KIND = JPIM), ALLOCATABLE :: IROSENDPTR(:)
     201  INTEGER(KIND = JPIM), ALLOCATABLE :: IRORECVPTR(:)
     202  INTEGER(KIND = JPIM), ALLOCATABLE :: IROCOMM(:)
     203  INTEGER(KIND = JPIM), ALLOCATABLE :: IROMAP(:, :)
     204  INTEGER(KIND = JPIM), ALLOCATABLE :: IGLOBALINDEX(:)
     205
     206  REAL(KIND = JPRB), ALLOCATABLE :: ZLATX(:)
     207  REAL(KIND = JPRB), ALLOCATABLE :: ZLONX(:)
     208  REAL(KIND = JPRB) :: ZHOOK_HANDLE
     209
     210  INTERFACE
    210211#include "setup_trans.h"
    211212#include "trans_inq.h"
    212 END INTERFACE
     213  END INTERFACE
    213214
    214215#include "abor1.intfb.h"
    … …  
    241242#include "su_mcica.intfb.h"
    242243
    243 !      ----------------------------------------------------------------
    244 
    245 #include "clesphys.h"
     244  !      ----------------------------------------------------------------
     245
    246246#include "naerad.h"
    247247#include "namrgri.h"
    248 !MPL/IM 20160915 on prend GES de phylmd
    249 
    250 !*         1.       INITIALIZE NEUROFLUX LONGWAVE RADIATION
    251 !                   ---------------------------------------
    252 
    253 IF (LHOOK) CALL DR_HOOK('SUECRAD',0,ZHOOK_HANDLE)
    254 !CALL GSTATS(1818,0)     MPL 2.12.08
    255 !IF (LERADN2) THEN
    256 !  CALL SULWNEUR(KLEV)
    257 !ENDIF
    258 
    259 !*         2.       SET DEFAULT VALUES.
    260 !                   -------------------
    261 
    262 !*         2.1      PRESET INDICES IN *YOERAD*
    263 !                   --------------------------
    264 
    265 LERAD1H=.FALSE.
    266 NLNGR1H=6
    267 
    268 LERADHS=.TRUE.
    269 LONEWSW=.TRUE.
    270 LECSRAD=.FALSE.
    271 
    272 !LE4ALB=.FALSE.
    273 !This is read from SU0PHY in NAEPHY and put in YOEPHY
    274 
    275 !- default setting of cloud optical properties
    276 !  liquid water cloud 0: Fouquart    (SW), Smith-Shi   (LW)
    277 !                     1: Slingo      (SW), Savijarvi   (LW)
    278 !                     2: Slingo      (SW), Lindner-Li  (LW)
    279 !  ice water cloud    0: Ebert-Curry (SW), Smith-Shi   (LW)
    280 !                     1: Ebert-Curry (SW), Ebert-Curry (LW)
    281 !                     2: Fu-Liou'93  (SW), Fu-Liou'93  (LW)
    282 !                     3: Fu'96       (SW), Fu et al'98 (LW)
    283 NLIQOPT=2           ! before 3?R1 default=0    2
    284 NICEOPT=3           ! before 3?R1 default=1    3
    285 
    286 !- default setting of cloud effective radius/diameter
    287 !  liquid water cloud 0: f(P) 10 to 45
    288 !                     1: 13: ocean; 10: land
    289 !                     2: Martin et al. CCN 50 over ocean, 900 over land
    290 !  ice water cloud    0: 40 microns
    291 !                     1: f(T) 40 to 130 microns
    292 !                     2: f(T) 30 to 60
    293 !                     3: f(T,IWC) Sun'01: 22.5 to 175 microns
    294 !  conversion factor between effective radius and particle size for ice
    295 NRADIP=3            ! before 3?R1 default=2     3
    296 NRADLP=2            ! before 3?R1 default=2     2
    297 print *,'SUECRAD: NRADLP, NRADIP=',NRADLP,NRADIP
    298 RRe2De=0.64952_JPRB ! before 3?R1 default=0.5_JPRB
    299 
    300 !- RRTM as LW scheme
    301 LRRTM = .FALSE.
    302 LECMWF = .FALSE.
    303 IF (iflag_rrtm.EQ.1) THEN
    304         LRRTM = .TRUE.
    305         LECMWF = .TRUE.
    306 !       LRRTM  = .FALSE.  ! Utiliser pour faire tourner le "vieux" rayonnement
    307 !       LECMWF = .FALSE.
    308 ENDIF
    309 
    310 !LRRTM  = .FALSE.
    311 
    312 !- SRTM as SW scheme
    313 !!!!! A REVOIR (MPL) verifier signification de LSRTM
    314 LSRTM = .FALSE.     ! before 3?R1 default was .FALSE.    true
    315 
    316 ! -- McICA treatment of cloud-radiation interactions
    317 ! - 1 is maximum-random, 2 is generalized cloud overlap (before 31R1 default=0 no McICA)
    318 NMcICA = 2          !  2 for generalized overlap
    319 
    320 !- Inhomogeneity factors in LW and SW (0=F, 1=0.7 in both, 2=Barker's, 3=Cairns)
    321 NINHOM = 0          ! before 3?R1 default=1
    322 NLAYINH= 0
    323 RLWINHF = 1.0_JPRB  ! before 3?R1 default=0.7
    324 RSWINHF = 1.0_JPRB  ! before 3?R1 default=0.7 
    325 !- Diffusivity correction a la Savijarvi
    326 LDIFFC = .FALSE.    ! before 31R1 default=.FALSE.
    327 
    328 !- history of volcanic aerosols
    329 LHVOLCA=.FALSE.
    330 !- monthly climatol. of tropospheric aerosols from Tegen et al. (1997)
    331 LNEWAER=.TRUE.
    332 !!! cpl LNOTROAER=.FALSE.
    333 LNOTROAER=.TRUE.
    334 NPERTAER=0
    335 
    336 !- New Rayleigh formulation
    337 LRAYL=.TRUE.
    338 
    339 !- Number concentration of aerosols if specified
    340 LCCNL=.TRUE.        ! before 3?R1 default=.FALSE.     true
    341 LCCNO=.TRUE.        ! before 3?R1 default=.FALSE.     true
    342 RCCNLND=900._JPRB   ! before 3?R1 default=900. now irrelevant
    343 RCCNSEA=50._JPRB    ! before 3?R1 default=50.  now irrelevant
    344 
    345 !- interaction radiation / prognostic O3 off by default
    346 LEPO3RA=.FALSE.
    347 print *,'SUECRAD-0'
    348 IF (.NOT.YO3%LGP) THEN
    349   LEPO3RA=.FALSE.
    350 ENDIF
    351 RPERTOZ=0._JPRB
    352 NPERTOZ=0
    353 
    354 !NAER: CONFIGURATION INDEX FOR AEROSOLS
    355 !!!!! A REVOIR (MPL) a mettre dans un fichier .def
    356 NAER   =1
    357 NMODE  =0
    358 NOZOCL =1
    359 NRADFR =-3
    360 IF (NSMAX >= 511) NRADFR =-1
    361 NRADPFR=0
    362 NRADPLA=15
    363 
    364 ! -- UV diagnostic of surface fluxes over the 280-400 nm interval
    365 !    with up-to 24 values (5 nm wide spectral intervals)
    366 LUVPROC=.FALSE.
    367 LUVTDEP=.TRUE.
    368 LUVDBG =.FALSE.
    369 NRADUV =-3
    370 NUVTIM = 0
    371 NUV    = 24
    372 RMUZUV = 1.E-01_JPRB
    373 DO JUV=1,NUV
    374   RUVLAM(JUV)=280._JPRB+(JUV-1)*5._JPRB
    375 ENDDO
    376 
    377 !- radiation interpolation (George M's grid on by default)
    378 LLDEBUG=.TRUE.
    379 LEDBUG=.FALSE.
    380 NRADINT=3
    381 NRADRES=0
    382 
    383 NRINT  =4
    384 
    385 LRADLB=.TRUE.
    386 CRTABLEDIR='./'
    387 CRTABLEFIL='not set'
    388 LRADONDEM=.TRUE.
    389 !GM Temporary as per trans/external/setup_trans.F90
    390 LLINEAR_GRID=NSMAX > (NDLON+3)/3
    391 IF( LLDEBUG )THEN
    392   WRITE(NULOUT,'("SUECRAD: NSMAX=",I6)')NSMAX
    393   WRITE(NULOUT,'("SUECRAD: NDLON=",I6)')NDLON
    394   WRITE(NULOUT,'("SUECRAD: LLINEAR_GRID=",L5)')LLINEAR_GRID
    395 ENDIF
    396 
    397 NUAER = 24
    398 NTRAER = 15
    399 ! 1: max-random, 2: max, 3: random (5,6,7,8 pour meso-NH)
    400 ! le CASE qui suit car les conventions sont differentes dans ARP et LMDZ (MPL 20100415)
    401 SELECT CASE (overlap)
     248  !MPL/IM 20160915 on prend GES de phylmd
     249
     250  !*         1.       INITIALIZE NEUROFLUX LONGWAVE RADIATION
     251  !                   ---------------------------------------
     252
     253  IF (LHOOK) CALL DR_HOOK('SUECRAD', 0, ZHOOK_HANDLE)
     254  !CALL GSTATS(1818,0)     MPL 2.12.08
     255  !IF (LERADN2) THEN
     256  !  CALL SULWNEUR(KLEV)
     257  !ENDIF
     258
     259  !*         2.       SET DEFAULT VALUES.
     260  !                   -------------------
     261
     262  !*         2.1      PRESET INDICES IN *YOERAD*
     263  !                   --------------------------
     264
     265  LERAD1H = .FALSE.
     266  NLNGR1H = 6
     267
     268  LERADHS = .TRUE.
     269  LONEWSW = .TRUE.
     270  LECSRAD = .FALSE.
     271
     272  !LE4ALB=.FALSE.
     273  !This is read from SU0PHY in NAEPHY and put in YOEPHY
     274
     275  !- default setting of cloud optical properties
     276  !  liquid water cloud 0: Fouquart    (SW), Smith-Shi   (LW)
     277  !                     1: Slingo      (SW), Savijarvi   (LW)
     278  !                     2: Slingo      (SW), Lindner-Li  (LW)
     279  !  ice water cloud    0: Ebert-Curry (SW), Smith-Shi   (LW)
     280  !                     1: Ebert-Curry (SW), Ebert-Curry (LW)
     281  !                     2: Fu-Liou'93  (SW), Fu-Liou'93  (LW)
     282  !                     3: Fu'96       (SW), Fu et al'98 (LW)
     283  NLIQOPT = 2           ! before 3?R1 default=0    2
     284  NICEOPT = 3           ! before 3?R1 default=1    3
     285
     286  !- default setting of cloud effective radius/diameter
     287  !  liquid water cloud 0: f(P) 10 to 45
     288  !                     1: 13: ocean; 10: land
     289  !                     2: Martin et al. CCN 50 over ocean, 900 over land
     290  !  ice water cloud    0: 40 microns
     291  !                     1: f(T) 40 to 130 microns
     292  !                     2: f(T) 30 to 60
     293  !                     3: f(T,IWC) Sun'01: 22.5 to 175 microns
     294  !  conversion factor between effective radius and particle size for ice
     295  NRADIP = 3            ! before 3?R1 default=2         3
     296  NRADLP = 2            ! before 3?R1 default=2 2
     297  print *, 'SUECRAD: NRADLP, NRADIP=', NRADLP, NRADIP
     298  RRe2De = 0.64952_JPRB ! before 3?R1 default=0.5_JPRB
     299
     300  !- RRTM as LW scheme
     301  LRRTM = .FALSE.
     302  LECMWF = .FALSE.
     303  IF (iflag_rrtm.EQ.1) THEN
     304    LRRTM = .TRUE.
     305    LECMWF = .TRUE.
     306    !       LRRTM  = .FALSE.  ! Utiliser pour faire tourner le "vieux" rayonnement
     307    !       LECMWF = .FALSE.
     308  ENDIF
     309
     310  !LRRTM  = .FALSE.
     311
     312  !- SRTM as SW scheme
     313  !!!!! A REVOIR (MPL) verifier signification de LSRTM
     314  LSRTM = .FALSE.     ! before 3?R1 default was .FALSE.    true
     315
     316  ! -- McICA treatment of cloud-radiation interactions
     317  ! - 1 is maximum-random, 2 is generalized cloud overlap (before 31R1 default=0 no McICA)
     318  NMcICA = 2          !  2 for generalized overlap
     319
     320  !- Inhomogeneity factors in LW and SW (0=F, 1=0.7 in both, 2=Barker's, 3=Cairns)
     321  NINHOM = 0          ! before 3?R1 default=1
     322  NLAYINH = 0
     323  RLWINHF = 1.0_JPRB  ! before 3?R1 default=0.7
     324  RSWINHF = 1.0_JPRB  ! before 3?R1 default=0.7
     325  !- Diffusivity correction a la Savijarvi
     326  LDIFFC = .FALSE.    ! before 31R1 default=.FALSE.
     327
     328  !- history of volcanic aerosols
     329  LHVOLCA = .FALSE.
     330  !- monthly climatol. of tropospheric aerosols from Tegen et al. (1997)
     331  LNEWAER = .TRUE.
     332  !!! cpl LNOTROAER=.FALSE.
     333  LNOTROAER = .TRUE.
     334  NPERTAER = 0
     335
     336  !- New Rayleigh formulation
     337  LRAYL = .TRUE.
     338
     339  !- Number concentration of aerosols if specified
     340  LCCNL = .TRUE.        ! before 3?R1 default=.FALSE.     true
     341  LCCNO = .TRUE.        ! before 3?R1 default=.FALSE.     true
     342  RCCNLND = 900._JPRB   ! before 3?R1 default=900. now irrelevant
     343  RCCNSEA = 50._JPRB    ! before 3?R1 default=50.  now irrelevant
     344
     345  !- interaction radiation / prognostic O3 off by default
     346  LEPO3RA = .FALSE.
     347  print *, 'SUECRAD-0'
     348  IF (.NOT.YO3%LGP) THEN
     349    LEPO3RA = .FALSE.
     350  ENDIF
     351  RPERTOZ = 0._JPRB
     352  NPERTOZ = 0
     353
     354  !NAER: CONFIGURATION INDEX FOR AEROSOLS
     355  !!!!! A REVOIR (MPL) a mettre dans un fichier .def
     356  NAER = 1
     357  NMODE = 0
     358  NOZOCL = 1
     359  NRADFR = -3
     360  IF (NSMAX >= 511) NRADFR = -1
     361  NRADPFR = 0
     362  NRADPLA = 15
     363
     364  ! -- UV diagnostic of surface fluxes over the 280-400 nm interval
     365  !    with up-to 24 values (5 nm wide spectral intervals)
     366  LUVPROC = .FALSE.
     367  LUVTDEP = .TRUE.
     368  LUVDBG = .FALSE.
     369  NRADUV = -3
     370  NUVTIM = 0
     371  NUV = 24
     372  RMUZUV = 1.E-01_JPRB
     373  DO JUV = 1, NUV
     374    RUVLAM(JUV) = 280._JPRB + (JUV - 1) * 5._JPRB
     375  ENDDO
     376
     377  !- radiation interpolation (George M's grid on by default)
     378  LLDEBUG = .TRUE.
     379  LEDBUG = .FALSE.
     380  NRADINT = 3
     381  NRADRES = 0
     382
     383  NRINT = 4
     384
     385  LRADLB = .TRUE.
     386  CRTABLEDIR = './'
     387  CRTABLEFIL = 'not set'
     388  LRADONDEM = .TRUE.
     389  !GM Temporary as per trans/external/setup_trans.F90
     390  LLINEAR_GRID = NSMAX > (NDLON + 3) / 3
     391  IF(LLDEBUG)THEN
     392    WRITE(NULOUT, '("SUECRAD: NSMAX=",I6)')NSMAX
     393    WRITE(NULOUT, '("SUECRAD: NDLON=",I6)')NDLON
     394    WRITE(NULOUT, '("SUECRAD: LLINEAR_GRID=",L5)')LLINEAR_GRID
     395  ENDIF
     396
     397  NUAER = 24
     398  NTRAER = 15
     399  ! 1: max-random, 2: max, 3: random (5,6,7,8 pour meso-NH)
     400  ! le CASE qui suit car les conventions sont differentes dans ARP et LMDZ (MPL 20100415)
     401  SELECT CASE (overlap)
    402402  CASE (:1)
    403    NOVLP = 2   
     403    NOVLP = 2
    404404  CASE (2)
    405    NOVLP = 3   
     405    NOVLP = 3
    406406  CASE (3:)
    407    NOVLP = 1   
     407    NOVLP = 1
    408408  END SELECT
    409 print *,'SUECRAD: NOVLP=',NOVLP
    410 NLW    = 16
    411 NTSW   = 14
    412 !NSW    = 6    !!!!! Maintenant dans config.def (MPL 20140213)
    413 NSWNL  = 6
    414 NSWTL  = 2
    415 NCSRADF= 1
    416 IF(NSMAX >= 106) THEN
    417   NRPROMA = 80
    418 ELSEIF(NSMAX == 63) THEN
    419   NRPROMA=48
    420 ELSE
    421   NRPROMA=64
    422 ENDIF
    423 
    424 !*         2.3      SET SECURITY PARAMETERS
    425 !                   -----------------------
    426 
    427 REPSC  = 1.E-04_JPRB
    428 REPSCO = 1.E-12_JPRB
    429 REPSCQ = 1.E-12_JPRB
    430 REPSCT = 1.E-12_JPRB
    431 REPSCW = 1.E-12_JPRB
    432 REPLOG = 1.E-12_JPRB
    433 
    434 
    435 !*          2.4     BACKGROUND GAS CONCENTRATIONS (IPCC/SACC, 1990)
    436 !                   -----------------------------------------------
    437 
    438 LECO2VAR=.FALSE.
    439 LHGHG   =.FALSE.
    440 NHINCSOL= 0
    441 NSCEN   = 1
    442 RSOLINC = RI0
    443 
    444 ! Valeurs d origine MPL 18052010
    445 !RCCO2   = 353.E-06_JPRB
    446 !RCCH4   = 1.72E-06_JPRB
    447 !RCN2O   = 310.E-09_JPRB
    448 !RCCFC11 = 280.E-12_JPRB
    449 !RCCFC12 = 484.E-12_JPRB
    450 
    451 ! Valeurs LMDZ (physiq.def) MPL 18052010
    452 !RCCO2   = 348.E-06_JPRB
    453 !RCCH4   = 1.65E-06_JPRB
    454 !RCN2O   = 306.E-09_JPRB
    455 !RCCFC11 = 280.E-12_JPRB
    456 !RCCFC12 = 484.E-12_JPRB
    457 
    458 !MPL/IM 20160915 on prend GES de phylmd
    459 RCCO2   = CO2_ppm * 1.0e-06
    460 RCCH4   = CH4_ppb * 1.0e-09
    461 RCN2O   = N2O_ppb * 1.0e-09
    462 RCCFC11 = CFC11_ppt * 1.0e-12
    463 RCCFC12 = CFC12_ppt * 1.0e-12
    464 !print *,'LMDZSUECRAD-1 RCCO2=',RCCO2
    465 !print *,'LMDZSUECRAD-1 RCCH4=',RCCH4
    466 !print *,'LMDZSUECRAD-1 RCN2O=',RCN2O
    467 !print *,'LMDZSUECRAD-1 RCCFC11=',RCCFC11
    468 !print *,'LMDZSUECRAD-1 RCCFC12=',RCCFC12
    469 !     ------------------------------------------------------------------
    470 
    471 !*         3.       READ VALUES OF RADIATION CONFIGURATION
    472 !                   --------------------------------------
    473 
    474 !CALL POSNAM(NULNAM,'NAERAD')
    475 !READ (NULNAM,NAERAD)
    476 print *,'SUECRAD-2'
    477 
    478 !CALL POSNAM(NULNAM,'NAEAER')
    479 !READ (NULNAM,NAEAER)
    480 
    481 !IF (NTYPAER(9) /= 0) THEN
    482 !  RGEMUV=(RLATVOL+90._JPRB)*RPI/180._JPRB
    483 !  RGELAV=RLONVOL*RPI/180._JPRB
    484 !  RCLONV=COS(RGELAV)
    485 !  RSLONV=SIN(RGELAV)
    486 !  DO J=1,NGPTOT-1
    487 !    IF (RGELAV > GELAM(J) .AND. RGELAV <= GELAM(J+1) .AND. &
    488 !      & RGEMUV < RMU(JL) .AND. RGEMUV >= RMU(JL+1) ) THEN
    489 !      RDGMUV=ABS( RMU(J+1) - RMU(J))
    490 !      RDGLAV=ABS( GELAM(J+1)-GELAM(J) )
    491 !      RDSLONV=ABS( SIN(GELAM(JL+1))-SIN(GELAM(JL)) )
    492 !      RDCLONV=ABS( COS(GELAM(JL+1))-COS(GELAM(JL)) )
    493 !    END IF
    494 !  END DO
    495 !END IF 
    496 
    497 !- reset some parameters if SW6 is used (revert to pre-CY3?R1 operational configuration)
    498 IF (.NOT.LSRTM) THEN
    499   NMcICA = 0
    500   LCCNL  = .FALSE.
    501   LCCNO  = .FALSE.
    502   LDIFFC = .FALSE.
    503   NICEOPT= 1
    504   NLIQOPT= 0
    505   NRADIP = 4
    506   NRADLP = 3
    507   RRe2De = 0.5_JPRB
    508   NINHOM = 1
    509   RLWINHF= 0.7_JPRB
    510   RSWINHF= 0.7_JPRB
    511 ENDIF
    512 print *,'SUECRAD-3'
    513 
    514 !- for McICA computations, make sure these parameters are as follows ...
    515 IF (NMCICA /= 0) THEN
    516   NINHOM = 0
    517   RLWINHF= 1.0_JPRB
    518   RSWINHF= 1.0_JPRB
    519 !-- read the XCW values for Raisanen-Cole-Barker cloud generator
    520   CALL SU_McICA
    521 ENDIF
    522 print *,'SUECRAD-4'
    523 
    524 
    525 
    526 IF( LLDEBUG )THEN
    527   WRITE(NULOUT,'("SUECRAD: NRADINT=",I2)')NRADINT
    528   WRITE(NULOUT,'("SUECRAD: NRADRES=",I4)')NRADRES
    529 ENDIF
    530 
    531 !     DETERMINE WHETHER NRPROMA IS NEGATIVE AND SET LOPTRPROMA
    532 
    533 LOPTRPROMA=NRPROMA > 0
    534 NRPROMA=ABS(NRPROMA)
    535 
    536 IF( NRADINT > 0 .AND. NRADRES == NSMAX )THEN
    537   WRITE(NULOUT,'("SUECRAD: NRADINT > 0 .AND. NRADRES = NSMAX, NRADINT RESET TO 0")')
    538   NRADINT=0
    539 ENDIF
    540 
    541 IF( NRADINT > 0 .AND. LRAYFM .AND. NAER /= 0 .AND. .NOT.LHVOLCA )THEN
    542 !   This combination is not supported as aerosol data would be
    543 !   required to be interpolated (see radintg)
    544   WRITE(NULOUT,'("SUECRAD: NRADINT>0, LRAYFM=T NAER /= 0 .AND. LHVOLCA=F,",&
    545    & " NRADRES RESET TO NSMAX (NO INTERPOLATION)")') 
    546   NRADRES=NSMAX
    547 ENDIF
    548 !CALL GSTATS(1818,1)      MPL 2.12.08
    549 
    550 100 CONTINUE
    551 
    552 IF( LERADI )THEN   ! START OF LERADI BLOCK
    553 
    554   IF( NRADINT == -1 )THEN
    555 
    556   !     INITIALISE DATA STRUCTURES REQUIRED FOR RADIATION INTERPOLATION
    557 
    558     LODBGRADI=.FALSE.
    559     CALL SUECRADI
    560 
    561   !     INITIALISE DATA STRUCTURES REQUIRED FOR RADIATION COURSE GRID
    562   !     LOAD BALANCING
    563 
    564     LODBGRADL=.FALSE.
    565 !   CALL SUECRADL    ! MPL 1.12.08
    566     CALL ABOR1('JUSTE APRES CALL SUECRADL COMMENTE')
    567 
    568   ELSEIF( NRADINT == 0 )THEN
    569 
    570     IF( NRADRES /= NSMAX )THEN
    571       WRITE(NULOUT,'("SUECRAD: NRADINT=0 REQUESTED, NRADRES RESET TO NSMAX")')
    572       NRADRES=NSMAX
    573     ENDIF
    574     RADGRID%NGPTOT=NGPTOT
    575 
    576     NARIB1=0
    577     NAROB1=0
    578 
    579   ELSEIF( NRADINT >=1 .AND. NRADINT <= 3 )THEN
    580 
    581     NARIB1=0
    582     NAROB1=0
    583 
    584 ! set the default radiation grid resolution for the current model resolution
    585 ! if not already specified
    586     IF( NRADRES == 0 )THEN
    587       IF( LLINEAR_GRID )THEN                ! RATIO OF GRID-POINTS (MODEL/RAD)
    588         IF( NSMAX == 63 )THEN               
    589           NRADRES=21                        ! 3.62
    590           LLINEAR_GRID=.FALSE.
    591         ENDIF
    592         IF( NSMAX ==   95 ) NRADRES=   95   ! 1.00
    593         IF( NSMAX ==  159 ) NRADRES=   63   ! 5.84
    594         IF( NSMAX ==  255 ) NRADRES=   95   ! 6.69
    595         IF( NSMAX ==  319 ) NRADRES=  159   ! 3.87
    596         IF( NSMAX ==  399 ) NRADRES=  159   ! 5.99
    597         IF( NSMAX ==  511 ) NRADRES=  255   ! 3.92
    598         IF( NSMAX ==  639 ) NRADRES=  319   ! 3.92
    599         IF( NSMAX ==  799 ) NRADRES=  399   ! 3.94
    600         IF( NSMAX == 1023 ) NRADRES=  511   ! 3.94
    601         IF( NSMAX == 1279 ) NRADRES=  639       !
    602         IF( NSMAX == 2047 ) NRADRES= 1023       !
    603       ELSE ! NOT LINEAR GRID               
    604         IF( NSMAX ==   21 ) NRADRES=   21   ! 1.00
    605         IF( NSMAX ==   42 ) NRADRES=   21   ! 3.62
    606         IF( NSMAX ==   63 ) NRADRES=   42   ! 2.17
    607         IF( NSMAX ==  106 ) NRADRES=   63   ! 2.69
    608         IF( NSMAX ==  170 ) NRADRES=   63   ! 6.69
    609         IF( NSMAX ==  213 ) NRADRES=  106   ! 3.87
    610         IF( NSMAX ==  266 ) NRADRES=  106   ! 5.99
    611         IF( NSMAX ==  341 ) NRADRES=  170   ! 3.92
    612         IF( NSMAX ==  426 ) NRADRES=  213   ! 3.92
    613         IF( NSMAX ==  533 ) NRADRES=  266   ! 3.94
    614         IF( NSMAX ==  682 ) NRADRES=  341   ! 3.94
     409  print *, 'SUECRAD: NOVLP=', NOVLP
     410  NLW = 16
     411  NTSW = 14
     412  !NSW    = 6    !!!!! Maintenant dans config.def (MPL 20140213)
     413  NSWNL = 6
     414  NSWTL = 2
     415  NCSRADF = 1
     416  IF(NSMAX >= 106) THEN
     417    NRPROMA = 80
     418  ELSEIF(NSMAX == 63) THEN
     419    NRPROMA = 48
     420  ELSE
     421    NRPROMA = 64
     422  ENDIF
     423
     424  !*         2.3      SET SECURITY PARAMETERS
     425  !                   -----------------------
     426
     427  REPSC = 1.E-04_JPRB
     428  REPSCO = 1.E-12_JPRB
     429  REPSCQ = 1.E-12_JPRB
     430  REPSCT = 1.E-12_JPRB
     431  REPSCW = 1.E-12_JPRB
     432  REPLOG = 1.E-12_JPRB
     433
     434
     435  !*          2.4     BACKGROUND GAS CONCENTRATIONS (IPCC/SACC, 1990)
     436  !                   -----------------------------------------------
     437
     438  LECO2VAR = .FALSE.
     439  LHGHG = .FALSE.
     440  NHINCSOL = 0
     441  NSCEN = 1
     442  RSOLINC = RI0
     443
     444  ! Valeurs d origine MPL 18052010
     445  !RCCO2   = 353.E-06_JPRB
     446  !RCCH4   = 1.72E-06_JPRB
     447  !RCN2O   = 310.E-09_JPRB
     448  !RCCFC11 = 280.E-12_JPRB
     449  !RCCFC12 = 484.E-12_JPRB
     450
     451  ! Valeurs LMDZ (physiq.def) MPL 18052010
     452  !RCCO2   = 348.E-06_JPRB
     453  !RCCH4   = 1.65E-06_JPRB
     454  !RCN2O   = 306.E-09_JPRB
     455  !RCCFC11 = 280.E-12_JPRB
     456  !RCCFC12 = 484.E-12_JPRB
     457
     458  !MPL/IM 20160915 on prend GES de phylmd
     459  RCCO2 = CO2_ppm * 1.0e-06
     460  RCCH4 = CH4_ppb * 1.0e-09
     461  RCN2O = N2O_ppb * 1.0e-09
     462  RCCFC11 = CFC11_ppt * 1.0e-12
     463  RCCFC12 = CFC12_ppt * 1.0e-12
     464  !print *,'LMDZSUECRAD-1 RCCO2=',RCCO2
     465  !print *,'LMDZSUECRAD-1 RCCH4=',RCCH4
     466  !print *,'LMDZSUECRAD-1 RCN2O=',RCN2O
     467  !print *,'LMDZSUECRAD-1 RCCFC11=',RCCFC11
     468  !print *,'LMDZSUECRAD-1 RCCFC12=',RCCFC12
     469  !     ------------------------------------------------------------------
     470
     471  !*         3.       READ VALUES OF RADIATION CONFIGURATION
     472  !                   --------------------------------------
     473
     474  !CALL POSNAM(NULNAM,'NAERAD')
     475  !READ (NULNAM,NAERAD)
     476  print *, 'SUECRAD-2'
     477
     478  !CALL POSNAM(NULNAM,'NAEAER')
     479  !READ (NULNAM,NAEAER)
     480
     481  !IF (NTYPAER(9) /= 0) THEN
     482  !  RGEMUV=(RLATVOL+90._JPRB)*RPI/180._JPRB
     483  !  RGELAV=RLONVOL*RPI/180._JPRB
     484  !  RCLONV=COS(RGELAV)
     485  !  RSLONV=SIN(RGELAV)
     486  !  DO J=1,NGPTOT-1
     487  !    IF (RGELAV > GELAM(J) .AND. RGELAV <= GELAM(J+1) .AND. &
     488  !      & RGEMUV < RMU(JL) .AND. RGEMUV >= RMU(JL+1) ) THEN
     489  !      RDGMUV=ABS( RMU(J+1) - RMU(J))
     490  !      RDGLAV=ABS( GELAM(J+1)-GELAM(J) )
     491  !      RDSLONV=ABS( SIN(GELAM(JL+1))-SIN(GELAM(JL)) )
     492  !      RDCLONV=ABS( COS(GELAM(JL+1))-COS(GELAM(JL)) )
     493  !    END IF
     494  !  END DO
     495  !END IF
     496
     497  !- reset some parameters if SW6 is used (revert to pre-CY3?R1 operational configuration)
     498  IF (.NOT.LSRTM) THEN
     499    NMcICA = 0
     500    LCCNL = .FALSE.
     501    LCCNO = .FALSE.
     502    LDIFFC = .FALSE.
     503    NICEOPT = 1
     504    NLIQOPT = 0
     505    NRADIP = 4
     506    NRADLP = 3
     507    RRe2De = 0.5_JPRB
     508    NINHOM = 1
     509    RLWINHF = 0.7_JPRB
     510    RSWINHF = 0.7_JPRB
     511  ENDIF
     512  print *, 'SUECRAD-3'
     513
     514  !- for McICA computations, make sure these parameters are as follows ...
     515  IF (NMCICA /= 0) THEN
     516    NINHOM = 0
     517    RLWINHF = 1.0_JPRB
     518    RSWINHF = 1.0_JPRB
     519    !-- read the XCW values for Raisanen-Cole-Barker cloud generator
     520    CALL SU_McICA
     521  ENDIF
     522  print *, 'SUECRAD-4'
     523
     524  IF(LLDEBUG)THEN
     525    WRITE(NULOUT, '("SUECRAD: NRADINT=",I2)')NRADINT
     526    WRITE(NULOUT, '("SUECRAD: NRADRES=",I4)')NRADRES
     527  ENDIF
     528
     529  !     DETERMINE WHETHER NRPROMA IS NEGATIVE AND SET LOPTRPROMA
     530
     531  LOPTRPROMA = NRPROMA > 0
     532  NRPROMA = ABS(NRPROMA)
     533
     534  IF(NRADINT > 0 .AND. NRADRES == NSMAX)THEN
     535    WRITE(NULOUT, '("SUECRAD: NRADINT > 0 .AND. NRADRES = NSMAX, NRADINT RESET TO 0")')
     536    NRADINT = 0
     537  ENDIF
     538
     539  IF(NRADINT > 0 .AND. LRAYFM .AND. NAER /= 0 .AND. .NOT.LHVOLCA)THEN
     540    !   This combination is not supported as aerosol data would be
     541    !   required to be interpolated (see radintg)
     542    WRITE(NULOUT, '("SUECRAD: NRADINT>0, LRAYFM=T NAER /= 0 .AND. LHVOLCA=F,",&
     543            & " NRADRES RESET TO NSMAX (NO INTERPOLATION)")')
     544    NRADRES = NSMAX
     545  ENDIF
     546  !CALL GSTATS(1818,1)      MPL 2.12.08
     547
     548  100 CONTINUE
     549
     550  IF(LERADI)THEN   ! START OF LERADI BLOCK
     551
     552    IF(NRADINT == -1)THEN
     553
     554      !     INITIALISE DATA STRUCTURES REQUIRED FOR RADIATION INTERPOLATION
     555
     556      LODBGRADI = .FALSE.
     557      CALL SUECRADI
     558
     559      !     INITIALISE DATA STRUCTURES REQUIRED FOR RADIATION COURSE GRID
     560      !     LOAD BALANCING
     561
     562      LODBGRADL = .FALSE.
     563      !   CALL SUECRADL    ! MPL 1.12.08
     564      CALL ABOR1('JUSTE APRES CALL SUECRADL COMMENTE')
     565
     566    ELSEIF(NRADINT == 0)THEN
     567
     568      IF(NRADRES /= NSMAX)THEN
     569        WRITE(NULOUT, '("SUECRAD: NRADINT=0 REQUESTED, NRADRES RESET TO NSMAX")')
     570        NRADRES = NSMAX
    615571      ENDIF
    616     ENDIF
    617 print *,'SUECRAD-5'
    618 
    619 ! test if radiation grid resolution has been set
    620     IF( NRADRES == 0 )THEN
    621       WRITE(NULOUT,'("SUECRAD: NRADRES NOT SET OR DEFAULT FOUND,NSMAX=",I4)')NSMAX
    622       CALL ABOR1('SUECRAD: NRADRES NOT SET OR DEFAULT FOUND')
    623     ENDIF
    624 
    625 ! test if no interpolation is required
    626     IF( NRADINT > 0 .AND. NRADRES == NSMAX )THEN
    627       WRITE(NULOUT,'("SUECRAD: NRADINT > 0 .AND. NRADRES = NSMAX, NRADINT RESET TO 0")')
    628       NRADINT=0
    629       GOTO 100
    630     ENDIF
    631 
    632 !    CALL GSTATS(1818,0)       MPL 2.12.08
    633     IF( CRTABLEFIL == 'not set' )THEN
    634       IF( LLINEAR_GRID )THEN
    635         IF( NRADRES < 1000 )THEN
    636           WRITE(CRTABLEFIL,'("rtablel_2",I3.3)')NRADRES
     572      RADGRID%NGPTOT = NGPTOT
     573
     574      NARIB1 = 0
     575      NAROB1 = 0
     576
     577    ELSEIF(NRADINT >=1 .AND. NRADINT <= 3)THEN
     578
     579      NARIB1 = 0
     580      NAROB1 = 0
     581
     582      ! set the default radiation grid resolution for the current model resolution
     583      ! if not already specified
     584      IF(NRADRES == 0)THEN
     585        IF(LLINEAR_GRID)THEN                ! RATIO OF GRID-POINTS (MODEL/RAD)
     586          IF(NSMAX == 63)THEN
     587            NRADRES = 21                        ! 3.62
     588            LLINEAR_GRID = .FALSE.
     589          ENDIF
     590          IF(NSMAX ==   95) NRADRES = 95   ! 1.00
     591          IF(NSMAX ==  159) NRADRES = 63   ! 5.84
     592          IF(NSMAX ==  255) NRADRES = 95   ! 6.69
     593          IF(NSMAX ==  319) NRADRES = 159   ! 3.87
     594          IF(NSMAX ==  399) NRADRES = 159   ! 5.99
     595          IF(NSMAX ==  511) NRADRES = 255   ! 3.92
     596          IF(NSMAX ==  639) NRADRES = 319   ! 3.92
     597          IF(NSMAX ==  799) NRADRES = 399   ! 3.94
     598          IF(NSMAX == 1023) NRADRES = 511   ! 3.94
     599          IF(NSMAX == 1279) NRADRES = 639       !
     600          IF(NSMAX == 2047) NRADRES = 1023       !
     601        ELSE ! NOT LINEAR GRID
     602          IF(NSMAX ==   21) NRADRES = 21   ! 1.00
     603          IF(NSMAX ==   42) NRADRES = 21   ! 3.62
     604          IF(NSMAX ==   63) NRADRES = 42   ! 2.17
     605          IF(NSMAX ==  106) NRADRES = 63   ! 2.69
     606          IF(NSMAX ==  170) NRADRES = 63   ! 6.69
     607          IF(NSMAX ==  213) NRADRES = 106   ! 3.87
     608          IF(NSMAX ==  266) NRADRES = 106   ! 5.99
     609          IF(NSMAX ==  341) NRADRES = 170   ! 3.92
     610          IF(NSMAX ==  426) NRADRES = 213   ! 3.92
     611          IF(NSMAX ==  533) NRADRES = 266   ! 3.94
     612          IF(NSMAX ==  682) NRADRES = 341   ! 3.94
     613        ENDIF
     614      ENDIF
     615      print *, 'SUECRAD-5'
     616
     617      ! test if radiation grid resolution has been set
     618      IF(NRADRES == 0)THEN
     619        WRITE(NULOUT, '("SUECRAD: NRADRES NOT SET OR DEFAULT FOUND,NSMAX=",I4)')NSMAX
     620        CALL ABOR1('SUECRAD: NRADRES NOT SET OR DEFAULT FOUND')
     621      ENDIF
     622
     623      ! test if no interpolation is required
     624      IF(NRADINT > 0 .AND. NRADRES == NSMAX)THEN
     625        WRITE(NULOUT, '("SUECRAD: NRADINT > 0 .AND. NRADRES = NSMAX, NRADINT RESET TO 0")')
     626        NRADINT = 0
     627        GOTO 100
     628      ENDIF
     629
     630      !    CALL GSTATS(1818,0)       MPL 2.12.08
     631      IF(CRTABLEFIL == 'not set')THEN
     632        IF(LLINEAR_GRID)THEN
     633          IF(NRADRES < 1000)THEN
     634            WRITE(CRTABLEFIL, '("rtablel_2",I3.3)')NRADRES
     635          ELSE
     636            WRITE(CRTABLEFIL, '("rtablel_2",I4.4)')NRADRES
     637          ENDIF
    637638        ELSE
    638           WRITE(CRTABLEFIL,'("rtablel_2",I4.4)')NRADRES
    639         ENDIF
    640       ELSE
    641         IF( NRADRES < 1000 )THEN
    642           WRITE(CRTABLEFIL,'("rtable_2" ,I3.3)')NRADRES
    643         ELSE
    644           WRITE(CRTABLEFIL,'("rtable_2" ,I4.4)')NRADRES
     639          IF(NRADRES < 1000)THEN
     640            WRITE(CRTABLEFIL, '("rtable_2" ,I3.3)')NRADRES
     641          ELSE
     642            WRITE(CRTABLEFIL, '("rtable_2" ,I4.4)')NRADRES
     643          ENDIF
    645644        ENDIF
    646645      ENDIF
    647     ENDIF
    648 !    CALL GSTATS(1818,1)       MPL 2.12.08
    649 
    650     RADGRID%NSMAX=NRADRES
    651 
    652     IF( MYPROC == JPIOMASTER )THEN
    653       IDIR=LEN_TRIM(CRTABLEDIR)
    654       IFIL=LEN_TRIM(CRTABLEFIL)
    655       CLFN=CRTABLEDIR(1:IDIR)//CRTABLEFIL(1:IFIL)
    656 ! Ce qui concerne NULRAD commente par MPL le 15.04.09
    657 !     OPEN(NULRAD,FILE=CLFN,ACTION="READ",ERR=999)
    658 !     GOTO 1000
    659 !     999 CONTINUE
    660 !     WRITE(NULOUT,'("SUECRAD: UNABLE TO OPEN FILE ",A)')CLFN
    661 !     CALL ABOR1('SUECRAD: UNABLE TO OPEN RADIATION GRID RTABLE FILE')
    662 !     1000 CONTINUE
    663       NRGRI(:)=0
    664 ! Ce qui concerne NAMRGRI commente par MPL le 15.04.09
    665 !     CALL POSNAM(NULRAD,'NAMRGRI')
    666 !     READ (NULRAD,NAMRGRI)
    667       IDGL=1
    668       DO WHILE( NRGRI(IDGL)>0 )
    669         IF( LLDEBUG )THEN
    670           WRITE(NULOUT,'("SUECRAD: NRGRI(",I4,")=",I4)')IDGL,NRGRI(IDGL)
    671         ENDIF
    672         IDGL=IDGL+1
    673       ENDDO
    674       IDGL=IDGL-1
    675       RADGRID%NDGLG=IDGL
    676       IF( LLDEBUG )THEN
    677         WRITE(NULOUT,'("SUECRAD: RADGRID%NDGLG=",I4)')RADGRID%NDGLG
     646      !    CALL GSTATS(1818,1)       MPL 2.12.08
     647
     648      RADGRID%NSMAX = NRADRES
     649
     650      IF(MYPROC == JPIOMASTER)THEN
     651        IDIR = LEN_TRIM(CRTABLEDIR)
     652        IFIL = LEN_TRIM(CRTABLEFIL)
     653        CLFN = CRTABLEDIR(1:IDIR) // CRTABLEFIL(1:IFIL)
     654        ! Ce qui concerne NULRAD commente par MPL le 15.04.09
     655        !     OPEN(NULRAD,FILE=CLFN,ACTION="READ",ERR=999)
     656        !     GOTO 1000
     657        !     999 CONTINUE
     658        !     WRITE(NULOUT,'("SUECRAD: UNABLE TO OPEN FILE ",A)')CLFN
     659        !     CALL ABOR1('SUECRAD: UNABLE TO OPEN RADIATION GRID RTABLE FILE')
     660        !     1000 CONTINUE
     661        NRGRI(:) = 0
     662        ! Ce qui concerne NAMRGRI commente par MPL le 15.04.09
     663        !     CALL POSNAM(NULRAD,'NAMRGRI')
     664        !     READ (NULRAD,NAMRGRI)
     665        IDGL = 1
     666        DO WHILE(NRGRI(IDGL)>0)
     667          IF(LLDEBUG)THEN
     668            WRITE(NULOUT, '("SUECRAD: NRGRI(",I4,")=",I4)')IDGL, NRGRI(IDGL)
     669          ENDIF
     670          IDGL = IDGL + 1
     671        ENDDO
     672        IDGL = IDGL - 1
     673        RADGRID%NDGLG = IDGL
     674        IF(LLDEBUG)THEN
     675          WRITE(NULOUT, '("SUECRAD: RADGRID%NDGLG=",I4)')RADGRID%NDGLG
     676        ENDIF
     677        !     CLOSE(NULRAD)
    678678      ENDIF
    679 !     CLOSE(NULRAD)
    680     ENDIF
    681 !    CALL GSTATS(667,0)     MPL 2.12.08
    682     IF( NPROC > 1 )THEN
    683       stop 'Pas pret pour proc > 1'
    684 !     CALL MPL_BROADCAST (RADGRID%NDGLG,MTAGRAD,JPIOMASTER,CDSTRING='SUECRAD:')
    685     ENDIF
    686     ALLOCATE(RADGRID%NRGRI(RADGRID%NDGLG))
    687     IF( MYPROC == JPIOMASTER )THEN
    688       RADGRID%NRGRI(1:RADGRID%NDGLG)=NRGRI(1:RADGRID%NDGLG)
    689     ENDIF
    690     IF( NPROC > 1 )THEN
    691       stop 'Pas pret pour proc > 1'
    692 !     CALL MPL_BROADCAST (RADGRID%NRGRI(1:RADGRID%NDGLG),MTAGRAD,JPIOMASTER,CDSTRING='SUECRAD:')
    693     ENDIF
    694 !    CALL GSTATS(667,1)      MPL 2.12.08
    695 
    696 !    CALL GSTATS(1818,0)     MPL 2.12.08
    697     IF    ( NRADINT == 1 )THEN
    698       WRITE(NULOUT,'("SUECRAD: INTERPOLATION METHOD - SPECTRAL TRANSFORM")')
    699       RADGRID%NDGSUR=0
    700       NRIWIDEN=0
    701       NRIWIDES=0
    702       NRIWIDEW=0
    703       NRIWIDEE=0
    704       NROWIDEN=0
    705       NROWIDES=0
    706       NROWIDEW=0
    707       NROWIDEE=0
    708     ELSEIF( NRADINT == 2 )THEN
    709       WRITE(NULOUT,'("SUECRAD: INTERPOLATION METHOD - 4 POINT")')
    710       RADGRID%NDGSUR=2
    711     ELSEIF( NRADINT == 3 )THEN
    712       WRITE(NULOUT,'("SUECRAD: INTERPOLATION METHOD - 12 POINT")')
    713       RADGRID%NDGSUR=2
    714     ENDIF
    715     WRITE(NULOUT,'("SUECRAD: RADGRID%NDGSUR       =",I8)')RADGRID%NDGSUR
    716 
    717     RADGRID%NDGSAG=1-RADGRID%NDGSUR
    718     RADGRID%NDGENG=RADGRID%NDGLG+RADGRID%NDGSUR
    719     RADGRID%NDLON=RADGRID%NRGRI(RADGRID%NDGLG/2)
    720     WRITE(NULOUT,'("SUECRAD: RADGRID%NDGSAG       =",I8)')RADGRID%NDGSAG
    721     WRITE(NULOUT,'("SUECRAD: RADGRID%NDGENG       =",I8)')RADGRID%NDGENG
    722     WRITE(NULOUT,'("SUECRAD: RADGRID%NDGLG        =",I8)')RADGRID%NDGLG
    723     WRITE(NULOUT,'("SUECRAD: RADGRID%NDLON        =",I8)')RADGRID%NDLON
    724     CALL FLUSH(NULOUT)
    725 
    726     ALLOCATE(RADGRID%NLOENG(RADGRID%NDGSAG:RADGRID%NDGENG))
    727     RADGRID%NLOENG(1:RADGRID%NDGLG)=RADGRID%NRGRI(1:RADGRID%NDGLG)
    728     IF(RADGRID%NDGSUR >= 1)THEN
    729       DO JGLSUR=1,RADGRID%NDGSUR
    730         RADGRID%NLOENG(1-JGLSUR)=RADGRID%NLOENG(JGLSUR)
    731       ENDDO
    732       DO JGLSUR=1,RADGRID%NDGSUR
    733         RADGRID%NLOENG(RADGRID%NDGLG+JGLSUR)=RADGRID%NLOENG(RADGRID%NDGLG+1-JGLSUR)
    734       ENDDO
    735     ENDIF
    736 !     CALL GSTATS(1818,1)     MPL 2.12.08
    737 
    738 ! Setup the transform package for the radiation grid
    739     CALL SETUP_TRANS (KSMAX=RADGRID%NSMAX, &
    740      & KDGL=RADGRID%NDGLG, &
    741      & KLOEN=RADGRID%NLOENG(1:RADGRID%NDGLG), &
    742      & LDLINEAR_GRID=LLINEAR_GRID, &
    743      & LDSPLIT=LSPLIT, &
    744      & KAPSETS=NAPSETS, &
    745      & KRESOL=RADGRID%NRESOL_ID)
    746 
    747     ALLOCATE(RADGRID%NSTA(RADGRID%NDGSAG:RADGRID%NDGENG+N_REGIONS_NS-1,N_REGIONS_EW))
    748     ALLOCATE(RADGRID%NONL(RADGRID%NDGSAG:RADGRID%NDGENG+N_REGIONS_NS-1,N_REGIONS_EW))
    749     ALLOCATE(RADGRID%NPTRFRSTLAT(N_REGIONS_NS))
    750     ALLOCATE(RADGRID%NFRSTLAT(N_REGIONS_NS))
    751     ALLOCATE(RADGRID%NLSTLAT(N_REGIONS_NS))
    752     ALLOCATE(RADGRID%RMU(RADGRID%NDGSAG:RADGRID%NDGENG))
    753     ALLOCATE(RADGRID%RSQM2(RADGRID%NDGSAG:RADGRID%NDGENG))
    754     ALLOCATE(RADGRID%RLATIG(RADGRID%NDGSAG:RADGRID%NDGENG))
    755 
    756 ! Interrogate the transform package for the radiation grid
    757 !    CALL GSTATS(1818,0)    MPL 2.12.08
    758     CALL TRANS_INQ (KRESOL     =RADGRID%NRESOL_ID, &
    759      & KSPEC2     =RADGRID%NSPEC2, &
    760      & KNUMP      =RADGRID%NUMP, &
    761      & KGPTOT     =RADGRID%NGPTOT, &
    762      & KGPTOTG    =RADGRID%NGPTOTG, &
    763      & KGPTOTMX   =RADGRID%NGPTOTMX, &
    764      & KPTRFRSTLAT=RADGRID%NPTRFRSTLAT, &
    765      & KFRSTLAT   =RADGRID%NFRSTLAT, &
    766      & KLSTLAT    =RADGRID%NLSTLAT, &
    767      & KFRSTLOFF  =RADGRID%NFRSTLOFF, &
    768      & KSTA       =RADGRID%NSTA(1:RADGRID%NDGLG+N_REGIONS_NS-1,:), &
    769      & KONL       =RADGRID%NONL(1:RADGRID%NDGLG+N_REGIONS_NS-1,:), &
    770      & KPTRFLOFF  =RADGRID%NPTRFLOFF, &
    771      & PMU        =RADGRID%RMU(1:) ) 
    772 
    773     IF( NRADINT == 2 .OR. NRADINT == 3 )THEN
    774       DO JGL=1,RADGRID%NDGLG
    775         RADGRID%RSQM2(JGL) = SQRT(1.0_JPRB - RADGRID%RMU(JGL)*RADGRID%RMU(JGL))
    776         RADGRID%RLATIG(JGL) = ASIN(RADGRID%RMU(JGL))
    777 !       WRITE(NULOUT,'("SUECRAD: JGL=",I6," RADGRID%RLATIG=",F10.3)')&
    778 !        & JGL,RADGRID%RLATIG(JGL)
    779       ENDDO
     679      !    CALL GSTATS(667,0)     MPL 2.12.08
     680      IF(NPROC > 1)THEN
     681        stop 'Pas pret pour proc > 1'
     682        !     CALL MPL_BROADCAST (RADGRID%NDGLG,MTAGRAD,JPIOMASTER,CDSTRING='SUECRAD:')
     683      ENDIF
     684      ALLOCATE(RADGRID%NRGRI(RADGRID%NDGLG))
     685      IF(MYPROC == JPIOMASTER)THEN
     686        RADGRID%NRGRI(1:RADGRID%NDGLG) = NRGRI(1:RADGRID%NDGLG)
     687      ENDIF
     688      IF(NPROC > 1)THEN
     689        stop 'Pas pret pour proc > 1'
     690        !     CALL MPL_BROADCAST (RADGRID%NRGRI(1:RADGRID%NDGLG),MTAGRAD,JPIOMASTER,CDSTRING='SUECRAD:')
     691      ENDIF
     692      !    CALL GSTATS(667,1)      MPL 2.12.08
     693
     694      !    CALL GSTATS(1818,0)     MPL 2.12.08
     695      IF    (NRADINT == 1)THEN
     696        WRITE(NULOUT, '("SUECRAD: INTERPOLATION METHOD - SPECTRAL TRANSFORM")')
     697        RADGRID%NDGSUR = 0
     698        NRIWIDEN = 0
     699        NRIWIDES = 0
     700        NRIWIDEW = 0
     701        NRIWIDEE = 0
     702        NROWIDEN = 0
     703        NROWIDES = 0
     704        NROWIDEW = 0
     705        NROWIDEE = 0
     706      ELSEIF(NRADINT == 2)THEN
     707        WRITE(NULOUT, '("SUECRAD: INTERPOLATION METHOD - 4 POINT")')
     708        RADGRID%NDGSUR = 2
     709      ELSEIF(NRADINT == 3)THEN
     710        WRITE(NULOUT, '("SUECRAD: INTERPOLATION METHOD - 12 POINT")')
     711        RADGRID%NDGSUR = 2
     712      ENDIF
     713      WRITE(NULOUT, '("SUECRAD: RADGRID%NDGSUR       =",I8)')RADGRID%NDGSUR
     714
     715      RADGRID%NDGSAG = 1 - RADGRID%NDGSUR
     716      RADGRID%NDGENG = RADGRID%NDGLG + RADGRID%NDGSUR
     717      RADGRID%NDLON = RADGRID%NRGRI(RADGRID%NDGLG / 2)
     718      WRITE(NULOUT, '("SUECRAD: RADGRID%NDGSAG       =",I8)')RADGRID%NDGSAG
     719      WRITE(NULOUT, '("SUECRAD: RADGRID%NDGENG       =",I8)')RADGRID%NDGENG
     720      WRITE(NULOUT, '("SUECRAD: RADGRID%NDGLG        =",I8)')RADGRID%NDGLG
     721      WRITE(NULOUT, '("SUECRAD: RADGRID%NDLON        =",I8)')RADGRID%NDLON
     722      CALL FLUSH(NULOUT)
     723
     724      ALLOCATE(RADGRID%NLOENG(RADGRID%NDGSAG:RADGRID%NDGENG))
     725      RADGRID%NLOENG(1:RADGRID%NDGLG) = RADGRID%NRGRI(1:RADGRID%NDGLG)
    780726      IF(RADGRID%NDGSUR >= 1)THEN
    781         DO JGLSUR=1,RADGRID%NDGSUR
    782           RADGRID%RMU(1-JGLSUR)=RADGRID%RMU(JGLSUR)
    783           RADGRID%RSQM2(1-JGLSUR)=RADGRID%RSQM2(JGLSUR)
    784           RADGRID%RLATIG(1-JGLSUR)=RPI-RADGRID%RLATIG(JGLSUR)
     727        DO JGLSUR = 1, RADGRID%NDGSUR
     728          RADGRID%NLOENG(1 - JGLSUR) = RADGRID%NLOENG(JGLSUR)
    785729        ENDDO
    786         DO JGLSUR=1,RADGRID%NDGSUR
    787           RADGRID%RMU(RADGRID%NDGLG+JGLSUR)=RADGRID%RMU(RADGRID%NDGLG+1-JGLSUR)
    788           RADGRID%RSQM2(RADGRID%NDGLG+JGLSUR)=RADGRID%RSQM2(RADGRID%NDGLG+1-JGLSUR)
    789           RADGRID%RLATIG(RADGRID%NDGLG+JGLSUR)=-RPI-RADGRID%RLATIG(RADGRID%NDGLG+1-JGLSUR)
     730        DO JGLSUR = 1, RADGRID%NDGSUR
     731          RADGRID%NLOENG(RADGRID%NDGLG + JGLSUR) = RADGRID%NLOENG(RADGRID%NDGLG + 1 - JGLSUR)
    790732        ENDDO
    791733      ENDIF
     734      !     CALL GSTATS(1818,1)     MPL 2.12.08
     735
     736      ! Setup the transform package for the radiation grid
     737      CALL SETUP_TRANS (KSMAX = RADGRID%NSMAX, &
     738              & KDGL = RADGRID%NDGLG, &
     739              & KLOEN = RADGRID%NLOENG(1:RADGRID%NDGLG), &
     740              & LDLINEAR_GRID = LLINEAR_GRID, &
     741              & LDSPLIT = LSPLIT, &
     742              & KAPSETS = NAPSETS, &
     743              & KRESOL = RADGRID%NRESOL_ID)
     744
     745      ALLOCATE(RADGRID%NSTA(RADGRID%NDGSAG:RADGRID%NDGENG + N_REGIONS_NS - 1, N_REGIONS_EW))
     746      ALLOCATE(RADGRID%NONL(RADGRID%NDGSAG:RADGRID%NDGENG + N_REGIONS_NS - 1, N_REGIONS_EW))
     747      ALLOCATE(RADGRID%NPTRFRSTLAT(N_REGIONS_NS))
     748      ALLOCATE(RADGRID%NFRSTLAT(N_REGIONS_NS))
     749      ALLOCATE(RADGRID%NLSTLAT(N_REGIONS_NS))
     750      ALLOCATE(RADGRID%RMU(RADGRID%NDGSAG:RADGRID%NDGENG))
     751      ALLOCATE(RADGRID%RSQM2(RADGRID%NDGSAG:RADGRID%NDGENG))
     752      ALLOCATE(RADGRID%RLATIG(RADGRID%NDGSAG:RADGRID%NDGENG))
     753
     754      ! Interrogate the transform package for the radiation grid
     755      !    CALL GSTATS(1818,0)    MPL 2.12.08
     756      CALL TRANS_INQ (KRESOL = RADGRID%NRESOL_ID, &
     757              & KSPEC2 = RADGRID%NSPEC2, &
     758              & KNUMP = RADGRID%NUMP, &
     759              & KGPTOT = RADGRID%NGPTOT, &
     760              & KGPTOTG = RADGRID%NGPTOTG, &
     761              & KGPTOTMX = RADGRID%NGPTOTMX, &
     762              & KPTRFRSTLAT = RADGRID%NPTRFRSTLAT, &
     763              & KFRSTLAT = RADGRID%NFRSTLAT, &
     764              & KLSTLAT = RADGRID%NLSTLAT, &
     765              & KFRSTLOFF = RADGRID%NFRSTLOFF, &
     766              & KSTA = RADGRID%NSTA(1:RADGRID%NDGLG + N_REGIONS_NS - 1, :), &
     767              & KONL = RADGRID%NONL(1:RADGRID%NDGLG + N_REGIONS_NS - 1, :), &
     768              & KPTRFLOFF = RADGRID%NPTRFLOFF, &
     769              & PMU = RADGRID%RMU(1:))
     770
     771      IF(NRADINT == 2 .OR. NRADINT == 3)THEN
     772        DO JGL = 1, RADGRID%NDGLG
     773          RADGRID%RSQM2(JGL) = SQRT(1.0_JPRB - RADGRID%RMU(JGL) * RADGRID%RMU(JGL))
     774          RADGRID%RLATIG(JGL) = ASIN(RADGRID%RMU(JGL))
     775          !       WRITE(NULOUT,'("SUECRAD: JGL=",I6," RADGRID%RLATIG=",F10.3)')&
     776          !        & JGL,RADGRID%RLATIG(JGL)
     777        ENDDO
     778        IF(RADGRID%NDGSUR >= 1)THEN
     779          DO JGLSUR = 1, RADGRID%NDGSUR
     780            RADGRID%RMU(1 - JGLSUR) = RADGRID%RMU(JGLSUR)
     781            RADGRID%RSQM2(1 - JGLSUR) = RADGRID%RSQM2(JGLSUR)
     782            RADGRID%RLATIG(1 - JGLSUR) = RPI - RADGRID%RLATIG(JGLSUR)
     783          ENDDO
     784          DO JGLSUR = 1, RADGRID%NDGSUR
     785            RADGRID%RMU(RADGRID%NDGLG + JGLSUR) = RADGRID%RMU(RADGRID%NDGLG + 1 - JGLSUR)
     786            RADGRID%RSQM2(RADGRID%NDGLG + JGLSUR) = RADGRID%RSQM2(RADGRID%NDGLG + 1 - JGLSUR)
     787            RADGRID%RLATIG(RADGRID%NDGLG + JGLSUR) = -RPI - RADGRID%RLATIG(RADGRID%NDGLG + 1 - JGLSUR)
     788          ENDDO
     789        ENDIF
     790      ENDIF
     791
     792      RADGRID%NDGSAL = 1
     793      RADGRID%NDGENL = RADGRID%NLSTLAT(MY_REGION_NS) - RADGRID%NFRSTLOFF
     794      RADGRID%NDSUR1 = 3 - MOD(RADGRID%NDLON, 2)
     795      IDLSUR = MAX(RADGRID%NDLON, 2 * RADGRID%NSMAX + 1)
     796      RADGRID%NDLSUR = IDLSUR + RADGRID%NDSUR1
     797      RADGRID%MYFRSTACTLAT = RADGRID%NFRSTLAT(MY_REGION_NS)
     798      RADGRID%MYLSTACTLAT = RADGRID%NLSTLAT(MY_REGION_NS)
     799
     800      WRITE(NULOUT, '("SUECRAD: RADGRID%NRESOL_ID    =",I8)')RADGRID%NRESOL_ID
     801      WRITE(NULOUT, '("SUECRAD: RADGRID%NSMAX        =",I8)')RADGRID%NSMAX
     802      WRITE(NULOUT, '("SUECRAD: RADGRID%NSPEC2       =",I8)')RADGRID%NSPEC2
     803      WRITE(NULOUT, '("SUECRAD: RADGRID%NGPTOT       =",I8)')RADGRID%NGPTOT
     804      WRITE(NULOUT, '("SUECRAD: RADGRID%NGPTOTG      =",I8)')RADGRID%NGPTOTG
     805      WRITE(NULOUT, '("SUECRAD: RADGRID%NDGSAL       =",I8)')RADGRID%NDGSAL
     806      WRITE(NULOUT, '("SUECRAD: RADGRID%NDGENL       =",I8)')RADGRID%NDGENL
     807      WRITE(NULOUT, '("SUECRAD: RADGRID%NDSUR1       =",I8)')RADGRID%NDSUR1
     808      WRITE(NULOUT, '("SUECRAD: RADGRID%NDLSUR       =",I8)')RADGRID%NDLSUR
     809      WRITE(NULOUT, '("SUECRAD: RADGRID%MYFRSTACTLAT =",I8)')RADGRID%MYFRSTACTLAT
     810      WRITE(NULOUT, '("SUECRAD: RADGRID%MYLSTACTLAT  =",I8)')RADGRID%MYLSTACTLAT
     811      CALL FLUSH(NULOUT)
     812
     813      ALLOCATE(RADGRID%NASM0(0:RADGRID%NSPEC2))
     814      ALLOCATE(RADGRID%MYMS(RADGRID%NUMP))
     815      CALL TRANS_INQ (KRESOL = RADGRID%NRESOL_ID, &
     816              & KASM0 = RADGRID%NASM0, &
     817              & KMYMS = RADGRID%MYMS)
     818
     819      ALLOCATE(RADGRID%GELAM(RADGRID%NGPTOT))
     820      ALLOCATE(RADGRID%GELAT(RADGRID%NGPTOT))
     821      ALLOCATE(RADGRID%GESLO(RADGRID%NGPTOT))
     822      ALLOCATE(RADGRID%GECLO(RADGRID%NGPTOT))
     823      ALLOCATE(RADGRID%GEMU (RADGRID%NGPTOT))
     824
     825      IOFF = 0
     826      ILAT = RADGRID%NPTRFLOFF
     827      DO JGLAT = RADGRID%NFRSTLAT(MY_REGION_NS), &
     828              & RADGRID%NLSTLAT(MY_REGION_NS)
     829        ZGEMU = RADGRID%RMU(JGLAT)
     830        ILAT = ILAT + 1
     831        ISTLON = RADGRID%NSTA(ILAT, MY_REGION_EW)
     832        IENDLON = ISTLON - 1 + RADGRID%NONL(ILAT, MY_REGION_EW)
     833
     834        DO JLON = ISTLON, IENDLON
     835          ZLON = REAL(JLON - 1, JPRB) * 2.0_JPRB * RPI &
     836                  & / REAL(RADGRID%NLOENG(JGLAT), JPRB)
     837          IOFF = IOFF + 1
     838          RADGRID%GELAM(IOFF) = ZLON
     839          RADGRID%GELAT(IOFF) = ASIN(ZGEMU)
     840          RADGRID%GESLO(IOFF) = SIN(ZLON)
     841          RADGRID%GECLO(IOFF) = COS(ZLON)
     842          RADGRID%GEMU (IOFF) = ZGEMU
     843        ENDDO
     844      ENDDO
     845
     846      IF(NRADINT == 2 .OR. NRADINT == 3)THEN
     847
     848        !   For grid point interpolations we need to calculate the halo size
     849        !   required by each processor
     850
     851        ALLOCATE(ZLATX(RADGRID%NGPTOTMX))
     852        ALLOCATE(ZLONX(RADGRID%NGPTOTMX))
     853        DO J = 1, RADGRID%NGPTOT
     854          ZLATX(J) = RADGRID%GELAT(J) / RPI * 2.0_JPRB * 90.0
     855          ZLONX(J) = (RADGRID%GELAM(J) - RPI) / RPI * 180.0
     856        ENDDO
     857        ZMINRADLAT = MINVAL(ZLATX(1:RADGRID%NGPTOT))
     858        ZMAXRADLAT = MAXVAL(ZLATX(1:RADGRID%NGPTOT))
     859        ZMINRADLON = MINVAL(ZLONX(1:RADGRID%NGPTOT))
     860        ZMAXRADLON = MAXVAL(ZLONX(1:RADGRID%NGPTOT))
     861        IF(LLDEBUG)THEN
     862          WRITE(NULOUT, '("RADGRID,BEGIN")')
     863          IF(MYPROC /= 1)THEN
     864            stop 'Pas pret pour proc > 1'
     865            !         CALL MPL_SEND(RADGRID%NGPTOT,KDEST=NPRCIDS(1),KTAG=1,CDSTRING='SUECRAD.R')
     866            !         CALL MPL_SEND(ZLATX(1:RADGRID%NGPTOT),KDEST=NPRCIDS(1),KTAG=2,CDSTRING='SUECRAD.R')
     867            !         CALL MPL_SEND(ZLONX(1:RADGRID%NGPTOT),KDEST=NPRCIDS(1),KTAG=3,CDSTRING='SUECRAD.R')
     868          ENDIF
     869          IF(MYPROC == 1)THEN
     870            DO JROC = 1, NPROC
     871              IF(JROC == MYPROC)THEN
     872                DO J = 1, RADGRID%NGPTOT
     873                  WRITE(NULOUT, '(F7.2,2X,F7.2,2X,I6)')ZLATX(J), ZLONX(J), MYPROC
     874                ENDDO
     875              ELSE
     876                stop 'Pas pret pour proc > 1'
     877                !             CALL MPL_RECV(IGPTOT,KSOURCE=NPRCIDS(JROC),KTAG=1,CDSTRING='SUECRAD.M')
     878                !             CALL MPL_RECV(ZLATX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=2,CDSTRING='SUECRAD.M')
     879                !             CALL MPL_RECV(ZLONX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=3,CDSTRING='SUECRAD.M')
     880                DO J = 1, IGPTOT
     881                  WRITE(NULOUT, '(F7.2,2X,F7.2,2X,I6)')ZLATX(J), ZLONX(J), JROC
     882                ENDDO
     883              ENDIF
     884            ENDDO
     885          ENDIF
     886          WRITE(NULOUT, '("RADGRID,END")')
     887        ENDIF
     888        DEALLOCATE(ZLATX)
     889        DEALLOCATE(ZLONX)
     890
     891        ALLOCATE(ZLATX(NGPTOTMX))
     892        ALLOCATE(ZLONX(NGPTOTMX))
     893        DO J = 1, NGPTOT
     894          ZLATX(J) = GELAT(J) / RPI * 2.0_JPRB * 90.0
     895          ZLONX(J) = (GELAM(J) - RPI) / RPI * 180.0
     896        ENDDO
     897        ZMINMDLLAT = MINVAL(ZLATX(1:NGPTOT))
     898        ZMAXMDLLAT = MAXVAL(ZLATX(1:NGPTOT))
     899        ZMINMDLLON = MINVAL(ZLONX(1:NGPTOT))
     900        ZMAXMDLLON = MAXVAL(ZLONX(1:NGPTOT))
     901        IF(LLDEBUG)THEN
     902          WRITE(NULOUT, '("MODELGRID,BEGIN")')
     903          IF(MYPROC /= 1)THEN
     904            stop 'Pas pret pour proc > 1'
     905            !         CALL MPL_SEND(NGPTOT,KDEST=NPRCIDS(1),KTAG=1,CDSTRING='SUECRAD')
     906            !         CALL MPL_SEND(ZLATX(1:NGPTOT),KDEST=NPRCIDS(1),KTAG=2,CDSTRING='SUECRAD')
     907            !         CALL MPL_SEND(ZLONX(1:NGPTOT),KDEST=NPRCIDS(1),KTAG=3,CDSTRING='SUECRAD')
     908            !         CALL MPL_SEND(NGLOBALINDEX(1:NGPTOT),KDEST=NPRCIDS(1),KTAG=4,CDSTRING='SUECRAD')
     909          ENDIF
     910          IF(MYPROC == 1)THEN
     911            DO JROC = 1, NPROC
     912              IF(JROC == MYPROC)THEN
     913                DO J = 1, NGPTOT
     914                  WRITE(NULOUT, '(F7.2,2X,F7.2,2X,I6,2X,I12)')ZLATX(J), ZLONX(J), MYPROC, NGLOBALINDEX(J)
     915                ENDDO
     916              ELSE
     917                stop 'Pas pret pour proc > 1'
     918                !             CALL MPL_RECV(IGPTOT,KSOURCE=NPRCIDS(JROC),KTAG=1,CDSTRING='SUECRAD')
     919                !             CALL MPL_RECV(ZLATX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=2,CDSTRING='SUECRAD')
     920                !             CALL MPL_RECV(ZLONX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=3,CDSTRING='SUECRAD')
     921                ALLOCATE(IGLOBALINDEX(1:IGPTOT))
     922                !             CALL MPL_RECV(IGLOBALINDEX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=4,CDSTRING='SUECRAD')
     923                DO J = 1, IGPTOT
     924                  WRITE(NULOUT, '(F7.2,2X,F7.2,2X,I6,2X,I12)')ZLATX(J), ZLONX(J), JROC, IGLOBALINDEX(J)
     925                ENDDO
     926                DEALLOCATE(IGLOBALINDEX)
     927              ENDIF
     928            ENDDO
     929          ENDIF
     930          WRITE(NULOUT, '("MODELGRID,END")')
     931        ENDIF
     932        DEALLOCATE(ZLATX)
     933        DEALLOCATE(ZLONX)
     934
     935        IF(LLDEBUG)THEN
     936          WRITE(NULOUT, '("ZMINRADLAT=",F10.2)')ZMINRADLAT
     937          WRITE(NULOUT, '("ZMINMDLLAT=",F10.2)')ZMINMDLLAT
     938          WRITE(NULOUT, '("ZMAXRADLAT=",F10.2)')ZMAXRADLAT
     939          WRITE(NULOUT, '("ZMAXMDLLAT=",F10.2)')ZMAXMDLLAT
     940          WRITE(NULOUT, '("ZMINRADLON=",F10.2)')ZMINRADLON
     941          WRITE(NULOUT, '("ZMINMDLLON=",F10.2)')ZMINMDLLON
     942          WRITE(NULOUT, '("ZMAXRADLON=",F10.2)')ZMAXRADLON
     943          WRITE(NULOUT, '("ZMAXMDLLON=",F10.2)')ZMAXMDLLON
     944        ENDIF
     945
     946        ZLAT = NDGLG / 180.
     947        ILATS_DIFF_C = CEILING(ABS(ZMINRADLAT - ZMINMDLLAT) * ZLAT)
     948        ILATS_DIFF_F = FLOOR  (ABS(ZMINRADLAT - ZMINMDLLAT) * ZLAT)
     949        IF(ZMINRADLAT < ZMINMDLLAT)THEN
     950          NRIWIDES = JP_MIN_HALO + ILATS_DIFF_C
     951        ELSE
     952          NRIWIDES = MAX(0, JP_MIN_HALO - ILATS_DIFF_F)
     953        ENDIF
     954        ILATS_DIFF_C = CEILING(ABS(ZMAXRADLAT - ZMAXMDLLAT) * ZLAT)
     955        ILATS_DIFF_F = FLOOR  (ABS(ZMAXRADLAT - ZMAXMDLLAT) * ZLAT)
     956        IF(ZMAXRADLAT < ZMAXMDLLAT)THEN
     957          NRIWIDEN = MAX(0, JP_MIN_HALO - ILATS_DIFF_F)
     958        ELSE
     959          NRIWIDEN = JP_MIN_HALO + ILATS_DIFF_C
     960        ENDIF
     961        ILATS_DIFF_C = CEILING(ABS(ZMINRADLON - ZMINMDLLON) * ZLAT)
     962        ILATS_DIFF_F = FLOOR  (ABS(ZMINRADLON - ZMINMDLLON) * ZLAT)
     963        IF(ZMINRADLON < ZMINMDLLON)THEN
     964          NRIWIDEW = JP_MIN_HALO + ILATS_DIFF_C
     965        ELSE
     966          NRIWIDEW = MAX(0, JP_MIN_HALO - ILATS_DIFF_F)
     967        ENDIF
     968        ILATS_DIFF_C = CEILING(ABS(ZMAXRADLON - ZMAXMDLLON) * ZLAT)
     969        ILATS_DIFF_F = FLOOR  (ABS(ZMAXRADLON - ZMAXMDLLON) * ZLAT)
     970        IF(ZMAXRADLON < ZMAXMDLLON)THEN
     971          NRIWIDEE = MAX(0, JP_MIN_HALO - ILATS_DIFF_F)
     972        ELSE
     973          NRIWIDEE = JP_MIN_HALO + ILATS_DIFF_C
     974        ENDIF
     975
     976        ZLAT = RADGRID%NDGLG / 180.
     977        ILATS_DIFF_C = CEILING(ABS(ZMINRADLAT - ZMINMDLLAT) * ZLAT)
     978        ILATS_DIFF_F = FLOOR  (ABS(ZMINRADLAT - ZMINMDLLAT) * ZLAT)
     979        IF(ZMINMDLLAT < ZMINRADLAT)THEN
     980          NROWIDES = JP_MIN_HALO + ILATS_DIFF_C
     981        ELSE
     982          NROWIDES = MAX(0, JP_MIN_HALO - ILATS_DIFF_F)
     983        ENDIF
     984        ILATS_DIFF_C = CEILING(ABS(ZMAXRADLAT - ZMAXMDLLAT) * ZLAT)
     985        ILATS_DIFF_F = FLOOR  (ABS(ZMAXRADLAT - ZMAXMDLLAT) * ZLAT)
     986        IF(ZMAXMDLLAT < ZMAXRADLAT)THEN
     987          NROWIDEN = MAX(0, JP_MIN_HALO - ILATS_DIFF_F)
     988        ELSE
     989          NROWIDEN = JP_MIN_HALO + ILATS_DIFF_C
     990        ENDIF
     991        ILATS_DIFF_C = CEILING(ABS(ZMINRADLON - ZMINMDLLON) * ZLAT)
     992        ILATS_DIFF_F = FLOOR  (ABS(ZMINRADLON - ZMINMDLLON) * ZLAT)
     993        IF(ZMINMDLLON < ZMINRADLON)THEN
     994          NROWIDEW = JP_MIN_HALO + ILATS_DIFF_C
     995        ELSE
     996          NROWIDEW = MAX(0, JP_MIN_HALO - ILATS_DIFF_F)
     997        ENDIF
     998        ILATS_DIFF_C = CEILING(ABS(ZMAXRADLON - ZMAXMDLLON) * ZLAT)
     999        ILATS_DIFF_F = FLOOR  (ABS(ZMAXRADLON - ZMAXMDLLON) * ZLAT)
     1000        IF(ZMAXMDLLON < ZMAXRADLON)THEN
     1001          NROWIDEE = MAX(0, JP_MIN_HALO - ILATS_DIFF_F)
     1002        ELSE
     1003          NROWIDEE = JP_MIN_HALO + ILATS_DIFF_C
     1004        ENDIF
     1005
     1006      ENDIF
     1007
     1008      RADGRID%NDGSAH = MAX(RADGRID%NDGSAG, &
     1009              & RADGRID%NDGSAL + RADGRID%NFRSTLOFF - NROWIDEN) - RADGRID%NFRSTLOFF
     1010      RADGRID%NDGENH = MIN(RADGRID%NDGENG, &
     1011              & RADGRID%NDGENL + RADGRID%NFRSTLOFF + NROWIDES) - RADGRID%NFRSTLOFF
     1012      WRITE(NULOUT, '("SUECRAD: RADGRID%NDGSAH       =",I8)')RADGRID%NDGSAH
     1013      WRITE(NULOUT, '("SUECRAD: RADGRID%NDGENH       =",I8)')RADGRID%NDGENH
     1014
     1015      IF(NRADINT == 2 .OR. NRADINT == 3)THEN
     1016
     1017        ILBRLATI = MAX(RADGRID%NDGSAG, &
     1018                & RADGRID%NDGSAL + RADGRID%NFRSTLOFF - NROWIDEN) - RADGRID%NFRSTLOFF
     1019        IUBRLATI = MIN(RADGRID%NDGENG, &
     1020                & RADGRID%NDGENL + RADGRID%NFRSTLOFF + NROWIDES) - RADGRID%NFRSTLOFF
     1021        ALLOCATE(RADGRID%RLATI(ILBRLATI:IUBRLATI))
     1022        ALLOCATE(RADGRID%RIPI0(ILBRLATI:IUBRLATI))
     1023        ALLOCATE(RADGRID%RIPI1(ILBRLATI:IUBRLATI))
     1024        ALLOCATE(RADGRID%RIPI2(ILBRLATI:IUBRLATI))
     1025
     1026        DO JGL = ILBRLATI, IUBRLATI
     1027          IGLGLO = JGL + RADGRID%NFRSTLOFF
     1028          IF(IGLGLO >= 0.AND.IGLGLO <= RADGRID%NDGLG) THEN
     1029            ZD1 = RADGRID%RLATIG(IGLGLO - 1) - RADGRID%RLATIG(IGLGLO)
     1030            ZD2 = RADGRID%RLATIG(IGLGLO - 1) - RADGRID%RLATIG(IGLGLO + 1)
     1031            ZD3 = RADGRID%RLATIG(IGLGLO - 1) - RADGRID%RLATIG(IGLGLO + 2)
     1032            ZD4 = RADGRID%RLATIG(IGLGLO) - RADGRID%RLATIG(IGLGLO + 1)
     1033            ZD5 = RADGRID%RLATIG(IGLGLO) - RADGRID%RLATIG(IGLGLO + 2)
     1034            ZD6 = RADGRID%RLATIG(IGLGLO + 1) - RADGRID%RLATIG(IGLGLO + 2)
     1035            RADGRID%RIPI0(JGL) = -1.0_JPRB / (ZD1 * ZD4 * ZD5)
     1036            RADGRID%RIPI1(JGL) = 1.0_JPRB / (ZD2 * ZD4 * ZD6)
     1037            RADGRID%RIPI2(JGL) = -1.0_JPRB / (ZD3 * ZD5 * ZD6)
     1038          ENDIF
     1039          RADGRID%RLATI(JGL) = RADGRID%RLATIG(IGLGLO)
     1040        ENDDO
     1041
     1042        IF(NPROC > 1)THEN
     1043          IRIRPTSUR = NGPTOTG
     1044          IRISPTSUR = 2 * NGPTOTG
     1045        ELSE
     1046          IRIRPTSUR = 0
     1047          IRISPTSUR = 0
     1048        ENDIF
     1049
     1050        ALLOCATE(NRISTA(NDGSAL - NRIWIDEN:NDGENL + NRIWIDES))
     1051        ALLOCATE(NRIONL(NDGSAL - NRIWIDEN:NDGENL + NRIWIDES))
     1052        ALLOCATE(NRIOFF(NDGSAL - NRIWIDEN:NDGENL + NRIWIDES))
     1053        ALLOCATE(NRIEXT(1 - NDLON:NDLON + NDLON, 1 - NRIWIDEN:NDGENL + NRIWIDES))
     1054        ALLOCATE(NRICORE(NGPTOT))
     1055        ALLOCATE(IRISENDPOS(IRISPTSUR))
     1056        ALLOCATE(IRIRECVPOS(IRIRPTSUR))
     1057        ALLOCATE(IRISENDPTR(NPROC + 1))
     1058        ALLOCATE(IRIRECVPTR(NPROC + 1))
     1059        ALLOCATE(IRICOMM(NPROC))
     1060        ALLOCATE(IRIMAP(4, NDGLG))
     1061        ! MPL 1.12.08
     1062        !     CALL RDCSET('RI',NRIWIDEN,NRIWIDES,NRIWIDEW,NRIWIDEE,&
     1063        !      & IRIRPTSUR,IRISPTSUR,&
     1064        !      & NDGLG,NDLON,NDGSAG,NDGENG,IDUM,IDUM,NDGSAL,NDGENL,&
     1065        !      & NDSUR1,NDLSUR,NDGSUR,NGPTOT,IDUM,&
     1066        !      & NPTRFLOFF,NFRSTLOFF,MYFRSTACTLAT,MYLSTACTLAT,&
     1067        !      & NSTA,NONL,NLOENG,NPTRFRSTLAT,NFRSTLAT,NLSTLAT,&
     1068        !      & RMU,RSQM2,&
     1069        !      & NRISTA,NRIONL,NRIOFF,NRIEXT,NRICORE,NARIB1,&
     1070        !      & NRIPROCS,NRIMPBUFSZ,NRIRPT,NRISPT,&
     1071        !      & IRISENDPOS,IRIRECVPOS,IRISENDPTR,IRIRECVPTR,IRICOMM,IRIMAP,IRIMAPLEN)
     1072        CALL ABOR1('JUSTE APRES CALL RDCSET COMMENTE')
     1073        WRITE(NULOUT, '("SUECRAD: NARIB1=",I12)')NARIB1
     1074        ALLOCATE(NRISENDPOS(NRISPT))
     1075        ALLOCATE(NRIRECVPOS(NRIRPT))
     1076        ALLOCATE(NRISENDPTR(NRIPROCS + 1))
     1077        ALLOCATE(NRIRECVPTR(NRIPROCS + 1))
     1078        ALLOCATE(NRICOMM(NRIPROCS))
     1079        NRISENDPOS(1:NRISPT) = IRISENDPOS(1:NRISPT)
     1080        NRIRECVPOS(1:NRIRPT) = IRIRECVPOS(1:NRIRPT)
     1081        NRISENDPTR(1:NRIPROCS + 1) = IRISENDPTR(1:NRIPROCS + 1)
     1082        NRIRECVPTR(1:NRIPROCS + 1) = IRIRECVPTR(1:NRIPROCS + 1)
     1083        NRICOMM(1:NRIPROCS) = IRICOMM(1:NRIPROCS)
     1084        DEALLOCATE(IRISENDPOS)
     1085        DEALLOCATE(IRIRECVPOS)
     1086        DEALLOCATE(IRISENDPTR)
     1087        DEALLOCATE(IRIRECVPTR)
     1088        DEALLOCATE(IRICOMM)
     1089        DEALLOCATE(IRIMAP)
     1090
     1091        IF(NPROC > 1)THEN
     1092          IRORPTSUR = RADGRID%NGPTOTG
     1093          IROSPTSUR = 2 * RADGRID%NGPTOTG
     1094        ELSE
     1095          IRORPTSUR = 0
     1096          IROSPTSUR = 0
     1097        ENDIF
     1098
     1099        ALLOCATE(NROSTA(RADGRID%NDGSAL - NROWIDEN:RADGRID%NDGENL + NROWIDES))
     1100        ALLOCATE(NROONL(RADGRID%NDGSAL - NROWIDEN:RADGRID%NDGENL + NROWIDES))
     1101        ALLOCATE(NROOFF(RADGRID%NDGSAL - NROWIDEN:RADGRID%NDGENL + NROWIDES))
     1102        ALLOCATE(NROEXT(1 - RADGRID%NDLON:RADGRID%NDLON + RADGRID%NDLON, &
     1103                & 1 - NROWIDEN:RADGRID%NDGENL + NROWIDES))
     1104        ALLOCATE(NROCORE(RADGRID%NGPTOT))
     1105        ALLOCATE(IROSENDPOS(IROSPTSUR))
     1106        ALLOCATE(IRORECVPOS(IRORPTSUR))
     1107        ALLOCATE(IROSENDPTR(NPROC + 1))
     1108        ALLOCATE(IRORECVPTR(NPROC + 1))
     1109        ALLOCATE(IROCOMM(NPROC))
     1110        ALLOCATE(IROMAP(4, RADGRID%NDGLG))
     1111        ! MPL 1.12.08
     1112        !     CALL RDCSET('RO',NROWIDEN,NROWIDES,NROWIDEW,NROWIDEE,&
     1113        !      & IRORPTSUR,IROSPTSUR,&
     1114        !      & RADGRID%NDGLG,RADGRID%NDLON,RADGRID%NDGSAG,&
     1115        !      & RADGRID%NDGENG,IDUM,IDUM,RADGRID%NDGSAL,RADGRID%NDGENL,&
     1116        !      & RADGRID%NDSUR1,RADGRID%NDLSUR,RADGRID%NDGSUR,RADGRID%NGPTOT,IDUM,&
     1117        !      & RADGRID%NPTRFLOFF,RADGRID%NFRSTLOFF,RADGRID%MYFRSTACTLAT,RADGRID%MYLSTACTLAT,&
     1118        !      & RADGRID%NSTA,RADGRID%NONL,RADGRID%NLOENG,RADGRID%NPTRFRSTLAT,&
     1119        !      & RADGRID%NFRSTLAT,RADGRID%NLSTLAT,&
     1120        !      & RADGRID%RMU,RADGRID%RSQM2,&
     1121        !      & NROSTA,NROONL,NROOFF,NROEXT,NROCORE,NAROB1,&
     1122        !      & NROPROCS,NROMPBUFSZ,NRORPT,NROSPT,&
     1123        !      & IROSENDPOS,IRORECVPOS,IROSENDPTR,IRORECVPTR,IROCOMM,IROMAP,IROMAPLEN)
     1124        CALL ABOR1('JUSTE APRES CALL RDCSET COMMENTE')
     1125        WRITE(NULOUT, '("SUECRAD: NAROB1=",I12)')NAROB1
     1126        ALLOCATE(NROSENDPOS(NROSPT))
     1127        ALLOCATE(NRORECVPOS(NRORPT))
     1128        ALLOCATE(NROSENDPTR(NROPROCS + 1))
     1129        ALLOCATE(NRORECVPTR(NROPROCS + 1))
     1130        ALLOCATE(NROCOMM(NROPROCS))
     1131        NROSENDPOS(1:NROSPT) = IROSENDPOS(1:NROSPT)
     1132        NRORECVPOS(1:NRORPT) = IRORECVPOS(1:NRORPT)
     1133        NROSENDPTR(1:NROPROCS + 1) = IROSENDPTR(1:NROPROCS + 1)
     1134        NRORECVPTR(1:NROPROCS + 1) = IRORECVPTR(1:NROPROCS + 1)
     1135        NROCOMM(1:NROPROCS) = IROCOMM(1:NROPROCS)
     1136        DEALLOCATE(IROSENDPOS)
     1137        DEALLOCATE(IRORECVPOS)
     1138        DEALLOCATE(IROSENDPTR)
     1139        DEALLOCATE(IRORECVPTR)
     1140        DEALLOCATE(IROCOMM)
     1141        DEALLOCATE(IROMAP)
     1142
     1143        IF(LLDEBUG)THEN
     1144          WRITE(NULOUT, '("")')
     1145          IRIWIDEMAXN = 0
     1146          IRIWIDEMAXS = 0
     1147          IRIWIDEMAXW = 0
     1148          IRIWIDEMAXE = 0
     1149          IROWIDEMAXN = 0
     1150          IROWIDEMAXS = 0
     1151          IROWIDEMAXW = 0
     1152          IROWIDEMAXE = 0
     1153          IARIB1MAX = 0
     1154          IAROB1MAX = 0
     1155          IWIDE(1) = NRIWIDEN
     1156          IWIDE(2) = NRIWIDES
     1157          IWIDE(3) = NRIWIDEW
     1158          IWIDE(4) = NRIWIDEE
     1159          IWIDE(5) = NROWIDEN
     1160          IWIDE(6) = NROWIDES
     1161          IWIDE(7) = NROWIDEW
     1162          IWIDE(8) = NROWIDEE
     1163          IWIDE(9) = NARIB1
     1164          IWIDE(10) = NAROB1
     1165          IF(MYPROC /= 1)THEN
     1166            stop 'Pas pret pour proc > 1'
     1167            !         CALL MPL_SEND(IWIDE(1:10),KDEST=NPRCIDS(1),KTAG=1,CDSTRING='SUECRAD.W')
     1168          ENDIF
     1169          IF(MYPROC == 1)THEN
     1170            DO JROC = 1, NPROC
     1171              IF(JROC /= MYPROC)THEN
     1172                stop 'Pas pret pour proc > 1'
     1173                !             CALL MPL_RECV(IWIDE(1:10),KSOURCE=NPRCIDS(JROC),KTAG=1,CDSTRING='SUECRAD.W')
     1174              ENDIF
     1175              WRITE(NULOUT, '("SUECRAD: PROC=",I5,2X,"NRIWIDEN=",I3,2X,"NROWIDEN=",I3 )')&
     1176                      & JROC, IWIDE(1), IWIDE(5)
     1177              WRITE(NULOUT, '("SUECRAD: PROC=",I5,2X,"NRIWIDES=",I3,2X,"NROWIDES=",I3 )')&
     1178                      & JROC, IWIDE(2), IWIDE(6)
     1179              WRITE(NULOUT, '("SUECRAD: PROC=",I5,2X,"NRIWIDEW=",I3,2X,"NROWIDEW=",I3 )')&
     1180                      & JROC, IWIDE(3), IWIDE(7)
     1181              WRITE(NULOUT, '("SUECRAD: PROC=",I5,2X,"NRIWIDEE=",I3,2X,"NROWIDEE=",I3 )')&
     1182                      & JROC, IWIDE(4), IWIDE(8)
     1183              WRITE(NULOUT, '("SUECRAD: PROC=",I5,2X,"NARIB1=",I10,2X,"NAROB1=",I10 )')&
     1184                      & JROC, IWIDE(9), IWIDE(10)
     1185              WRITE(NULOUT, '("")')
     1186              IF(IWIDE(1) > IRIWIDEMAXN) IRIWIDEMAXN = IWIDE(1)
     1187              IF(IWIDE(2) > IRIWIDEMAXS) IRIWIDEMAXS = IWIDE(2)
     1188              IF(IWIDE(3) > IRIWIDEMAXW) IRIWIDEMAXW = IWIDE(3)
     1189              IF(IWIDE(4) > IRIWIDEMAXE) IRIWIDEMAXE = IWIDE(4)
     1190              IF(IWIDE(5) > IROWIDEMAXN) IROWIDEMAXN = IWIDE(5)
     1191              IF(IWIDE(6) > IROWIDEMAXS) IROWIDEMAXS = IWIDE(6)
     1192              IF(IWIDE(7) > IROWIDEMAXW) IROWIDEMAXW = IWIDE(7)
     1193              IF(IWIDE(8) > IROWIDEMAXE) IROWIDEMAXE = IWIDE(8)
     1194              IF(IWIDE(9)  > IARIB1MAX) IARIB1MAX = IWIDE(9)
     1195              IF(IWIDE(10) > IAROB1MAX) IAROB1MAX = IWIDE(10)
     1196            ENDDO
     1197            WRITE(NULOUT, '("")')
     1198            WRITE(NULOUT, '("SUECRAD: NRIWIDEN(MAX)  =",I8)')IRIWIDEMAXN
     1199            WRITE(NULOUT, '("SUECRAD: NRIWIDES(MAX)  =",I8)')IRIWIDEMAXS
     1200            WRITE(NULOUT, '("SUECRAD: NRIWIDEW(MAX)  =",I8)')IRIWIDEMAXW
     1201            WRITE(NULOUT, '("SUECRAD: NRIWIDEE(MAX)  =",I8)')IRIWIDEMAXE
     1202            WRITE(NULOUT, '("SUECRAD: NROWIDEN(MAX)  =",I8)')IROWIDEMAXN
     1203            WRITE(NULOUT, '("SUECRAD: NROWIDES(MAX)  =",I8)')IROWIDEMAXS
     1204            WRITE(NULOUT, '("SUECRAD: NROWIDEW(MAX)  =",I8)')IROWIDEMAXW
     1205            WRITE(NULOUT, '("SUECRAD: NROWIDEE(MAX)  =",I8)')IROWIDEMAXE
     1206            WRITE(NULOUT, '("SUECRAD: NARIB1(MAX)    =",I10)')IARIB1MAX
     1207            WRITE(NULOUT, '("SUECRAD: NAROB1(MAX)    =",I10)')IAROB1MAX
     1208            WRITE(NULOUT, '("")')
     1209          ENDIF
     1210          CALL FLUSH(NULOUT)
     1211        ENDIF
     1212
     1213      ENDIF
     1214      !    CALL GSTATS(1818,1)      MPL 2.12.08
     1215
     1216    ELSE
     1217
     1218      WRITE(NULOUT, '("SUECRAD: INVALID VALUE FOR NRADINT=",I6)')NRADINT
     1219      CALL ABOR1('SUECRAD: NRADINT INVALID')
     1220
    7921221    ENDIF
    7931222
    794     RADGRID%NDGSAL=1
    795     RADGRID%NDGENL=RADGRID%NLSTLAT(MY_REGION_NS)-RADGRID%NFRSTLOFF
    796     RADGRID%NDSUR1=3-MOD(RADGRID%NDLON,2)
    797     IDLSUR=MAX(RADGRID%NDLON,2*RADGRID%NSMAX+1)
    798     RADGRID%NDLSUR=IDLSUR+RADGRID%NDSUR1
    799     RADGRID%MYFRSTACTLAT=RADGRID%NFRSTLAT(MY_REGION_NS)
    800     RADGRID%MYLSTACTLAT=RADGRID%NLSTLAT(MY_REGION_NS)
    801 
    802     WRITE(NULOUT,'("SUECRAD: RADGRID%NRESOL_ID    =",I8)')RADGRID%NRESOL_ID
    803     WRITE(NULOUT,'("SUECRAD: RADGRID%NSMAX        =",I8)')RADGRID%NSMAX
    804     WRITE(NULOUT,'("SUECRAD: RADGRID%NSPEC2       =",I8)')RADGRID%NSPEC2
    805     WRITE(NULOUT,'("SUECRAD: RADGRID%NGPTOT       =",I8)')RADGRID%NGPTOT
    806     WRITE(NULOUT,'("SUECRAD: RADGRID%NGPTOTG      =",I8)')RADGRID%NGPTOTG
    807     WRITE(NULOUT,'("SUECRAD: RADGRID%NDGSAL       =",I8)')RADGRID%NDGSAL
    808     WRITE(NULOUT,'("SUECRAD: RADGRID%NDGENL       =",I8)')RADGRID%NDGENL
    809     WRITE(NULOUT,'("SUECRAD: RADGRID%NDSUR1       =",I8)')RADGRID%NDSUR1
    810     WRITE(NULOUT,'("SUECRAD: RADGRID%NDLSUR       =",I8)')RADGRID%NDLSUR
    811     WRITE(NULOUT,'("SUECRAD: RADGRID%MYFRSTACTLAT =",I8)')RADGRID%MYFRSTACTLAT
    812     WRITE(NULOUT,'("SUECRAD: RADGRID%MYLSTACTLAT  =",I8)')RADGRID%MYLSTACTLAT
    813     CALL FLUSH(NULOUT)
    814 
    815     ALLOCATE(RADGRID%NASM0(0:RADGRID%NSPEC2))
    816     ALLOCATE(RADGRID%MYMS(RADGRID%NUMP))
    817     CALL TRANS_INQ (KRESOL     =RADGRID%NRESOL_ID, &
    818      & KASM0      =RADGRID%NASM0, &
    819      & KMYMS      =RADGRID%MYMS ) 
    820 
    821     ALLOCATE(RADGRID%GELAM(RADGRID%NGPTOT))
    822     ALLOCATE(RADGRID%GELAT(RADGRID%NGPTOT))
    823     ALLOCATE(RADGRID%GESLO(RADGRID%NGPTOT))
    824     ALLOCATE(RADGRID%GECLO(RADGRID%NGPTOT))
    825     ALLOCATE(RADGRID%GEMU (RADGRID%NGPTOT))
    826 
    827     IOFF=0
    828     ILAT=RADGRID%NPTRFLOFF
    829     DO JGLAT=RADGRID%NFRSTLAT(MY_REGION_NS), &
    830        & RADGRID%NLSTLAT(MY_REGION_NS) 
    831       ZGEMU=RADGRID%RMU(JGLAT)
    832       ILAT=ILAT+1
    833       ISTLON  = RADGRID%NSTA(ILAT,MY_REGION_EW)
    834       IENDLON = ISTLON-1 + RADGRID%NONL(ILAT,MY_REGION_EW)
    835 
    836       DO JLON=ISTLON,IENDLON
    837         ZLON=  REAL(JLON-1,JPRB)*2.0_JPRB*RPI &
    838          & /REAL(RADGRID%NLOENG(JGLAT),JPRB) 
    839         IOFF=IOFF+1
    840         RADGRID%GELAM(IOFF) = ZLON
    841         RADGRID%GELAT(IOFF) = ASIN(ZGEMU)
    842         RADGRID%GESLO(IOFF) = SIN(ZLON)
    843         RADGRID%GECLO(IOFF) = COS(ZLON)
    844         RADGRID%GEMU (IOFF) = ZGEMU
    845       ENDDO
    846     ENDDO
    847 
    848     IF( NRADINT == 2 .OR. NRADINT == 3 )THEN
    849 
    850 !   For grid point interpolations we need to calculate the halo size
    851 !   required by each processor
    852 
    853       ALLOCATE(ZLATX(RADGRID%NGPTOTMX))
    854       ALLOCATE(ZLONX(RADGRID%NGPTOTMX))
    855       DO J=1,RADGRID%NGPTOT
    856         ZLATX(J)=RADGRID%GELAT(J)/RPI*2.0_JPRB*90.0
    857         ZLONX(J)=(RADGRID%GELAM(J)-RPI)/RPI*180.0
    858       ENDDO
    859       ZMINRADLAT=MINVAL(ZLATX(1:RADGRID%NGPTOT))
    860       ZMAXRADLAT=MAXVAL(ZLATX(1:RADGRID%NGPTOT))
    861       ZMINRADLON=MINVAL(ZLONX(1:RADGRID%NGPTOT))
    862       ZMAXRADLON=MAXVAL(ZLONX(1:RADGRID%NGPTOT))
    863       IF( LLDEBUG )THEN
    864         WRITE(NULOUT,'("RADGRID,BEGIN")')
    865         IF( MYPROC /= 1 )THEN
    866           stop 'Pas pret pour proc > 1'
    867 !         CALL MPL_SEND(RADGRID%NGPTOT,KDEST=NPRCIDS(1),KTAG=1,CDSTRING='SUECRAD.R')
    868 !         CALL MPL_SEND(ZLATX(1:RADGRID%NGPTOT),KDEST=NPRCIDS(1),KTAG=2,CDSTRING='SUECRAD.R')
    869 !         CALL MPL_SEND(ZLONX(1:RADGRID%NGPTOT),KDEST=NPRCIDS(1),KTAG=3,CDSTRING='SUECRAD.R')
    870         ENDIF
    871         IF( MYPROC == 1 )THEN
    872           DO JROC=1,NPROC
    873             IF( JROC == MYPROC )THEN
    874               DO J=1,RADGRID%NGPTOT
    875                 WRITE(NULOUT,'(F7.2,2X,F7.2,2X,I6)')ZLATX(J),ZLONX(J),MYPROC
    876               ENDDO
    877             ELSE
    878               stop 'Pas pret pour proc > 1'
    879 !             CALL MPL_RECV(IGPTOT,KSOURCE=NPRCIDS(JROC),KTAG=1,CDSTRING='SUECRAD.M')
    880 !             CALL MPL_RECV(ZLATX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=2,CDSTRING='SUECRAD.M')
    881 !             CALL MPL_RECV(ZLONX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=3,CDSTRING='SUECRAD.M')
    882               DO J=1,IGPTOT
    883                 WRITE(NULOUT,'(F7.2,2X,F7.2,2X,I6)')ZLATX(J),ZLONX(J),JROC
    884               ENDDO
    885             ENDIF
    886           ENDDO
    887         ENDIF
    888         WRITE(NULOUT,'("RADGRID,END")')
    889       ENDIF
    890       DEALLOCATE(ZLATX)
    891       DEALLOCATE(ZLONX)
    892  
    893       ALLOCATE(ZLATX(NGPTOTMX))
    894       ALLOCATE(ZLONX(NGPTOTMX))
    895       DO J=1,NGPTOT
    896         ZLATX(J)=GELAT(J)/RPI*2.0_JPRB*90.0
    897         ZLONX(J)=(GELAM(J)-RPI)/RPI*180.0
    898       ENDDO
    899       ZMINMDLLAT=MINVAL(ZLATX(1:NGPTOT))
    900       ZMAXMDLLAT=MAXVAL(ZLATX(1:NGPTOT))
    901       ZMINMDLLON=MINVAL(ZLONX(1:NGPTOT))
    902       ZMAXMDLLON=MAXVAL(ZLONX(1:NGPTOT))
    903       IF( LLDEBUG )THEN
    904         WRITE(NULOUT,'("MODELGRID,BEGIN")')
    905         IF( MYPROC /= 1 )THEN
    906           stop 'Pas pret pour proc > 1'
    907 !         CALL MPL_SEND(NGPTOT,KDEST=NPRCIDS(1),KTAG=1,CDSTRING='SUECRAD')
    908 !         CALL MPL_SEND(ZLATX(1:NGPTOT),KDEST=NPRCIDS(1),KTAG=2,CDSTRING='SUECRAD')
    909 !         CALL MPL_SEND(ZLONX(1:NGPTOT),KDEST=NPRCIDS(1),KTAG=3,CDSTRING='SUECRAD')
    910 !         CALL MPL_SEND(NGLOBALINDEX(1:NGPTOT),KDEST=NPRCIDS(1),KTAG=4,CDSTRING='SUECRAD')
    911         ENDIF
    912         IF( MYPROC == 1 )THEN
    913           DO JROC=1,NPROC
    914             IF( JROC == MYPROC )THEN
    915               DO J=1,NGPTOT
    916                 WRITE(NULOUT,'(F7.2,2X,F7.2,2X,I6,2X,I12)')ZLATX(J),ZLONX(J),MYPROC,NGLOBALINDEX(J)
    917               ENDDO
    918             ELSE
    919               stop 'Pas pret pour proc > 1'
    920 !             CALL MPL_RECV(IGPTOT,KSOURCE=NPRCIDS(JROC),KTAG=1,CDSTRING='SUECRAD')
    921 !             CALL MPL_RECV(ZLATX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=2,CDSTRING='SUECRAD')
    922 !             CALL MPL_RECV(ZLONX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=3,CDSTRING='SUECRAD')
    923               ALLOCATE(IGLOBALINDEX(1:IGPTOT))
    924 !             CALL MPL_RECV(IGLOBALINDEX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=4,CDSTRING='SUECRAD')
    925               DO J=1,IGPTOT
    926                 WRITE(NULOUT,'(F7.2,2X,F7.2,2X,I6,2X,I12)')ZLATX(J),ZLONX(J),JROC,IGLOBALINDEX(J)
    927               ENDDO
    928               DEALLOCATE(IGLOBALINDEX)
    929             ENDIF
    930           ENDDO
    931         ENDIF
    932         WRITE(NULOUT,'("MODELGRID,END")')
    933       ENDIF
    934       DEALLOCATE(ZLATX)
    935       DEALLOCATE(ZLONX)
    936  
    937       IF( LLDEBUG )THEN
    938         WRITE(NULOUT,'("ZMINRADLAT=",F10.2)')ZMINRADLAT
    939         WRITE(NULOUT,'("ZMINMDLLAT=",F10.2)')ZMINMDLLAT
    940         WRITE(NULOUT,'("ZMAXRADLAT=",F10.2)')ZMAXRADLAT
    941         WRITE(NULOUT,'("ZMAXMDLLAT=",F10.2)')ZMAXMDLLAT
    942         WRITE(NULOUT,'("ZMINRADLON=",F10.2)')ZMINRADLON
    943         WRITE(NULOUT,'("ZMINMDLLON=",F10.2)')ZMINMDLLON
    944         WRITE(NULOUT,'("ZMAXRADLON=",F10.2)')ZMAXRADLON
    945         WRITE(NULOUT,'("ZMAXMDLLON=",F10.2)')ZMAXMDLLON
    946       ENDIF
    947 
    948       ZLAT=NDGLG/180.
    949       ILATS_DIFF_C=CEILING(ABS(ZMINRADLAT-ZMINMDLLAT)*ZLAT)
    950       ILATS_DIFF_F=FLOOR  (ABS(ZMINRADLAT-ZMINMDLLAT)*ZLAT)
    951       IF( ZMINRADLAT < ZMINMDLLAT )THEN
    952         NRIWIDES=JP_MIN_HALO+ILATS_DIFF_C
    953       ELSE
    954         NRIWIDES=MAX(0,JP_MIN_HALO-ILATS_DIFF_F)
    955       ENDIF
    956       ILATS_DIFF_C=CEILING(ABS(ZMAXRADLAT-ZMAXMDLLAT)*ZLAT)
    957       ILATS_DIFF_F=FLOOR  (ABS(ZMAXRADLAT-ZMAXMDLLAT)*ZLAT)
    958       IF( ZMAXRADLAT < ZMAXMDLLAT )THEN
    959         NRIWIDEN=MAX(0,JP_MIN_HALO-ILATS_DIFF_F)
    960       ELSE
    961         NRIWIDEN=JP_MIN_HALO+ILATS_DIFF_C
    962       ENDIF
    963       ILATS_DIFF_C=CEILING(ABS(ZMINRADLON-ZMINMDLLON)*ZLAT)
    964       ILATS_DIFF_F=FLOOR  (ABS(ZMINRADLON-ZMINMDLLON)*ZLAT)
    965       IF( ZMINRADLON < ZMINMDLLON )THEN
    966         NRIWIDEW=JP_MIN_HALO+ILATS_DIFF_C
    967       ELSE
    968         NRIWIDEW=MAX(0,JP_MIN_HALO-ILATS_DIFF_F)
    969       ENDIF
    970       ILATS_DIFF_C=CEILING(ABS(ZMAXRADLON-ZMAXMDLLON)*ZLAT)
    971       ILATS_DIFF_F=FLOOR  (ABS(ZMAXRADLON-ZMAXMDLLON)*ZLAT)
    972       IF( ZMAXRADLON < ZMAXMDLLON )THEN
    973         NRIWIDEE=MAX(0,JP_MIN_HALO-ILATS_DIFF_F)
    974       ELSE
    975         NRIWIDEE=JP_MIN_HALO+ILATS_DIFF_C
    976       ENDIF
    977 
    978       ZLAT=RADGRID%NDGLG/180.
    979       ILATS_DIFF_C=CEILING(ABS(ZMINRADLAT-ZMINMDLLAT)*ZLAT)
    980       ILATS_DIFF_F=FLOOR  (ABS(ZMINRADLAT-ZMINMDLLAT)*ZLAT)
    981       IF( ZMINMDLLAT < ZMINRADLAT )THEN
    982         NROWIDES=JP_MIN_HALO+ILATS_DIFF_C
    983       ELSE
    984         NROWIDES=MAX(0,JP_MIN_HALO-ILATS_DIFF_F)
    985       ENDIF
    986       ILATS_DIFF_C=CEILING(ABS(ZMAXRADLAT-ZMAXMDLLAT)*ZLAT)
    987       ILATS_DIFF_F=FLOOR  (ABS(ZMAXRADLAT-ZMAXMDLLAT)*ZLAT)
    988       IF( ZMAXMDLLAT < ZMAXRADLAT )THEN
    989         NROWIDEN=MAX(0,JP_MIN_HALO-ILATS_DIFF_F)
    990       ELSE
    991         NROWIDEN=JP_MIN_HALO+ILATS_DIFF_C
    992       ENDIF
    993       ILATS_DIFF_C=CEILING(ABS(ZMINRADLON-ZMINMDLLON)*ZLAT)
    994       ILATS_DIFF_F=FLOOR  (ABS(ZMINRADLON-ZMINMDLLON)*ZLAT)
    995       IF( ZMINMDLLON < ZMINRADLON )THEN
    996         NROWIDEW=JP_MIN_HALO+ILATS_DIFF_C
    997       ELSE
    998         NROWIDEW=MAX(0,JP_MIN_HALO-ILATS_DIFF_F)
    999       ENDIF
    1000       ILATS_DIFF_C=CEILING(ABS(ZMAXRADLON-ZMAXMDLLON)*ZLAT)
    1001       ILATS_DIFF_F=FLOOR  (ABS(ZMAXRADLON-ZMAXMDLLON)*ZLAT)
    1002       IF( ZMAXMDLLON < ZMAXRADLON )THEN
    1003         NROWIDEE=MAX(0,JP_MIN_HALO-ILATS_DIFF_F)
    1004       ELSE
    1005         NROWIDEE=JP_MIN_HALO+ILATS_DIFF_C
    1006       ENDIF
    1007 
     1223  ENDIF              ! END OF LERADI BLOCK
     1224
     1225  !      ----------------------------------------------------------------
     1226
     1227  !*       4.    INITIALIZE RADIATION COEFFICIENTS.
     1228  !              ----------------------------------
     1229
     1230  RCDAY = RDAY * RG / RCPD
     1231  DIFF = 1.66_JPRB
     1232  R10E = 0.4342945_JPRB
     1233
     1234  ! CALL GSTATS(1818,0)    MPL 2.12.08
     1235  CALL SURDI
     1236
     1237  IF (NINHOM == 0) THEN
     1238    RLWINHF = 1._JPRB
     1239    RSWINHF = 1._JPRB
     1240  ENDIF
     1241
     1242  !      ----------------------------------------------------------------
     1243
     1244  !*       5.    INITIALIZE RADIATION ABSORPTION COEFFICIENTS
     1245  !              --------------------------------------------
     1246
     1247  !*       5.1.  Initialization routine for RRTM
     1248  !              -------------------------------
     1249
     1250  CALL SURRTAB
     1251  CALL SURRTPK
     1252  CALL SURRTRF
     1253  CALL SURRTFTR
     1254
     1255  IF (LRRTM) THEN
     1256    IF (KLEV > JPLAY) THEN
     1257      WRITE(UNIT = KULOUT, &
     1258              & FMT = '('' RRTM MAXIMUM NUMBER OF LAYERS IS REACHED'',&
     1259              & '' CALL ABORT'')')
     1260      CALL ABOR1(' ABOR1 CALLED SUECRAD')
    10081261    ENDIF
    10091262
    1010     RADGRID%NDGSAH=MAX(RADGRID%NDGSAG,&
    1011      & RADGRID%NDGSAL+RADGRID%NFRSTLOFF-NROWIDEN)-RADGRID%NFRSTLOFF 
    1012     RADGRID%NDGENH=MIN(RADGRID%NDGENG,&
    1013      & RADGRID%NDGENL+RADGRID%NFRSTLOFF+NROWIDES)-RADGRID%NFRSTLOFF 
    1014     WRITE(NULOUT,'("SUECRAD: RADGRID%NDGSAH       =",I8)')RADGRID%NDGSAH
    1015     WRITE(NULOUT,'("SUECRAD: RADGRID%NDGENH       =",I8)')RADGRID%NDGENH
    1016 
    1017     IF( NRADINT == 2 .OR. NRADINT == 3 )THEN
    1018 
    1019       ILBRLATI = MAX(RADGRID%NDGSAG,&
    1020        & RADGRID%NDGSAL+RADGRID%NFRSTLOFF-NROWIDEN)-RADGRID%NFRSTLOFF 
    1021       IUBRLATI = MIN(RADGRID%NDGENG,&
    1022        & RADGRID%NDGENL+RADGRID%NFRSTLOFF+NROWIDES)-RADGRID%NFRSTLOFF 
    1023       ALLOCATE(RADGRID%RLATI(ILBRLATI:IUBRLATI))
    1024       ALLOCATE(RADGRID%RIPI0(ILBRLATI:IUBRLATI))
    1025       ALLOCATE(RADGRID%RIPI1(ILBRLATI:IUBRLATI))
    1026       ALLOCATE(RADGRID%RIPI2(ILBRLATI:IUBRLATI))
    1027  
    1028       DO JGL= ILBRLATI,IUBRLATI
    1029         IGLGLO=JGL+RADGRID%NFRSTLOFF
    1030         IF(IGLGLO >= 0.AND.IGLGLO <= RADGRID%NDGLG) THEN
    1031           ZD1=RADGRID%RLATIG(IGLGLO-1)-RADGRID%RLATIG(IGLGLO)
    1032           ZD2=RADGRID%RLATIG(IGLGLO-1)-RADGRID%RLATIG(IGLGLO+1)
    1033           ZD3=RADGRID%RLATIG(IGLGLO-1)-RADGRID%RLATIG(IGLGLO+2)
    1034           ZD4=RADGRID%RLATIG(IGLGLO  )-RADGRID%RLATIG(IGLGLO+1)
    1035           ZD5=RADGRID%RLATIG(IGLGLO  )-RADGRID%RLATIG(IGLGLO+2)
    1036           ZD6=RADGRID%RLATIG(IGLGLO+1)-RADGRID%RLATIG(IGLGLO+2)
    1037           RADGRID%RIPI0(JGL)=-1.0_JPRB/(ZD1*ZD4*ZD5)
    1038           RADGRID%RIPI1(JGL)= 1.0_JPRB/(ZD2*ZD4*ZD6)
    1039           RADGRID%RIPI2(JGL)=-1.0_JPRB/(ZD3*ZD5*ZD6)
    1040         ENDIF
    1041         RADGRID%RLATI(JGL)=RADGRID%RLATIG(IGLGLO)
    1042       ENDDO
    1043 
    1044       IF( NPROC > 1 )THEN
    1045         IRIRPTSUR=NGPTOTG
    1046         IRISPTSUR=2*NGPTOTG
    1047       ELSE
    1048         IRIRPTSUR=0
    1049         IRISPTSUR=0
    1050       ENDIF
    1051 
    1052       ALLOCATE(NRISTA(NDGSAL-NRIWIDEN:NDGENL+NRIWIDES))
    1053       ALLOCATE(NRIONL(NDGSAL-NRIWIDEN:NDGENL+NRIWIDES))
    1054       ALLOCATE(NRIOFF(NDGSAL-NRIWIDEN:NDGENL+NRIWIDES))
    1055       ALLOCATE(NRIEXT(1-NDLON:NDLON+NDLON,1-NRIWIDEN:NDGENL+NRIWIDES))
    1056       ALLOCATE(NRICORE(NGPTOT))
    1057       ALLOCATE(IRISENDPOS(IRISPTSUR))
    1058       ALLOCATE(IRIRECVPOS(IRIRPTSUR))
    1059       ALLOCATE(IRISENDPTR(NPROC+1))
    1060       ALLOCATE(IRIRECVPTR(NPROC+1))
    1061       ALLOCATE(IRICOMM(NPROC))
    1062       ALLOCATE(IRIMAP(4,NDGLG))
    1063 ! MPL 1.12.08     
    1064 !     CALL RDCSET('RI',NRIWIDEN,NRIWIDES,NRIWIDEW,NRIWIDEE,&
    1065 !      & IRIRPTSUR,IRISPTSUR,&
    1066 !      & NDGLG,NDLON,NDGSAG,NDGENG,IDUM,IDUM,NDGSAL,NDGENL,&
    1067 !      & NDSUR1,NDLSUR,NDGSUR,NGPTOT,IDUM,&
    1068 !      & NPTRFLOFF,NFRSTLOFF,MYFRSTACTLAT,MYLSTACTLAT,&
    1069 !      & NSTA,NONL,NLOENG,NPTRFRSTLAT,NFRSTLAT,NLSTLAT,&
    1070 !      & RMU,RSQM2,&
    1071 !      & NRISTA,NRIONL,NRIOFF,NRIEXT,NRICORE,NARIB1,&
    1072 !      & NRIPROCS,NRIMPBUFSZ,NRIRPT,NRISPT,&
    1073 !      & IRISENDPOS,IRIRECVPOS,IRISENDPTR,IRIRECVPTR,IRICOMM,IRIMAP,IRIMAPLEN) 
    1074       CALL ABOR1('JUSTE APRES CALL RDCSET COMMENTE')
    1075       WRITE(NULOUT,'("SUECRAD: NARIB1=",I12)')NARIB1
    1076       ALLOCATE(NRISENDPOS(NRISPT))
    1077       ALLOCATE(NRIRECVPOS(NRIRPT))
    1078       ALLOCATE(NRISENDPTR(NRIPROCS+1))
    1079       ALLOCATE(NRIRECVPTR(NRIPROCS+1))
    1080       ALLOCATE(NRICOMM(NRIPROCS))
    1081       NRISENDPOS(1:NRISPT)=IRISENDPOS(1:NRISPT)
    1082       NRIRECVPOS(1:NRIRPT)=IRIRECVPOS(1:NRIRPT)
    1083       NRISENDPTR(1:NRIPROCS+1)=IRISENDPTR(1:NRIPROCS+1)
    1084       NRIRECVPTR(1:NRIPROCS+1)=IRIRECVPTR(1:NRIPROCS+1)
    1085       NRICOMM(1:NRIPROCS)=IRICOMM(1:NRIPROCS)
    1086       DEALLOCATE(IRISENDPOS)
    1087       DEALLOCATE(IRIRECVPOS)
    1088       DEALLOCATE(IRISENDPTR)
    1089       DEALLOCATE(IRIRECVPTR)
    1090       DEALLOCATE(IRICOMM)
    1091       DEALLOCATE(IRIMAP)
    1092 
    1093       IF( NPROC > 1 )THEN
    1094         IRORPTSUR=RADGRID%NGPTOTG
    1095         IROSPTSUR=2*RADGRID%NGPTOTG
    1096       ELSE
    1097         IRORPTSUR=0
    1098         IROSPTSUR=0
    1099       ENDIF
    1100 
    1101       ALLOCATE(NROSTA(RADGRID%NDGSAL-NROWIDEN:RADGRID%NDGENL+NROWIDES))
    1102       ALLOCATE(NROONL(RADGRID%NDGSAL-NROWIDEN:RADGRID%NDGENL+NROWIDES))
    1103       ALLOCATE(NROOFF(RADGRID%NDGSAL-NROWIDEN:RADGRID%NDGENL+NROWIDES))
    1104       ALLOCATE(NROEXT(1-RADGRID%NDLON:RADGRID%NDLON+RADGRID%NDLON,&
    1105        & 1-NROWIDEN:RADGRID%NDGENL+NROWIDES)) 
    1106       ALLOCATE(NROCORE(RADGRID%NGPTOT))
    1107       ALLOCATE(IROSENDPOS(IROSPTSUR))
    1108       ALLOCATE(IRORECVPOS(IRORPTSUR))
    1109       ALLOCATE(IROSENDPTR(NPROC+1))
    1110       ALLOCATE(IRORECVPTR(NPROC+1))
    1111       ALLOCATE(IROCOMM(NPROC))
    1112       ALLOCATE(IROMAP(4,RADGRID%NDGLG))
    1113 ! MPL 1.12.08     
    1114 !     CALL RDCSET('RO',NROWIDEN,NROWIDES,NROWIDEW,NROWIDEE,&
    1115 !      & IRORPTSUR,IROSPTSUR,&
    1116 !      & RADGRID%NDGLG,RADGRID%NDLON,RADGRID%NDGSAG,&
    1117 !      & RADGRID%NDGENG,IDUM,IDUM,RADGRID%NDGSAL,RADGRID%NDGENL,&
    1118 !      & RADGRID%NDSUR1,RADGRID%NDLSUR,RADGRID%NDGSUR,RADGRID%NGPTOT,IDUM,&
    1119 !      & RADGRID%NPTRFLOFF,RADGRID%NFRSTLOFF,RADGRID%MYFRSTACTLAT,RADGRID%MYLSTACTLAT,&
    1120 !      & RADGRID%NSTA,RADGRID%NONL,RADGRID%NLOENG,RADGRID%NPTRFRSTLAT,&
    1121 !      & RADGRID%NFRSTLAT,RADGRID%NLSTLAT,&
    1122 !      & RADGRID%RMU,RADGRID%RSQM2,&
    1123 !      & NROSTA,NROONL,NROOFF,NROEXT,NROCORE,NAROB1,&
    1124 !      & NROPROCS,NROMPBUFSZ,NRORPT,NROSPT,&
    1125 !      & IROSENDPOS,IRORECVPOS,IROSENDPTR,IRORECVPTR,IROCOMM,IROMAP,IROMAPLEN) 
    1126       CALL ABOR1('JUSTE APRES CALL RDCSET COMMENTE')
    1127       WRITE(NULOUT,'("SUECRAD: NAROB1=",I12)')NAROB1
    1128       ALLOCATE(NROSENDPOS(NROSPT))
    1129       ALLOCATE(NRORECVPOS(NRORPT))
    1130       ALLOCATE(NROSENDPTR(NROPROCS+1))
    1131       ALLOCATE(NRORECVPTR(NROPROCS+1))
    1132       ALLOCATE(NROCOMM(NROPROCS))
    1133       NROSENDPOS(1:NROSPT)=IROSENDPOS(1:NROSPT)
    1134       NRORECVPOS(1:NRORPT)=IRORECVPOS(1:NRORPT)
    1135       NROSENDPTR(1:NROPROCS+1)=IROSENDPTR(1:NROPROCS+1)
    1136       NRORECVPTR(1:NROPROCS+1)=IRORECVPTR(1:NROPROCS+1)
    1137       NROCOMM(1:NROPROCS)=IROCOMM(1:NROPROCS)
    1138       DEALLOCATE(IROSENDPOS)
    1139       DEALLOCATE(IRORECVPOS)
    1140       DEALLOCATE(IROSENDPTR)
    1141       DEALLOCATE(IRORECVPTR)
    1142       DEALLOCATE(IROCOMM)
    1143       DEALLOCATE(IROMAP)
    1144 
    1145       IF( LLDEBUG )THEN
    1146         WRITE(NULOUT,'("")')
    1147         IRIWIDEMAXN=0
    1148         IRIWIDEMAXS=0
    1149         IRIWIDEMAXW=0
    1150         IRIWIDEMAXE=0
    1151         IROWIDEMAXN=0
    1152         IROWIDEMAXS=0
    1153         IROWIDEMAXW=0
    1154         IROWIDEMAXE=0
    1155         IARIB1MAX=0
    1156         IAROB1MAX=0
    1157         IWIDE(1)=NRIWIDEN
    1158         IWIDE(2)=NRIWIDES
    1159         IWIDE(3)=NRIWIDEW
    1160         IWIDE(4)=NRIWIDEE
    1161         IWIDE(5)=NROWIDEN
    1162         IWIDE(6)=NROWIDES
    1163         IWIDE(7)=NROWIDEW
    1164         IWIDE(8)=NROWIDEE
    1165         IWIDE(9)=NARIB1
    1166         IWIDE(10)=NAROB1
    1167         IF( MYPROC /= 1 )THEN
    1168           stop 'Pas pret pour proc > 1'
    1169 !         CALL MPL_SEND(IWIDE(1:10),KDEST=NPRCIDS(1),KTAG=1,CDSTRING='SUECRAD.W')
    1170         ENDIF
    1171         IF( MYPROC == 1 )THEN
    1172           DO JROC=1,NPROC
    1173             IF( JROC /= MYPROC )THEN
    1174               stop 'Pas pret pour proc > 1'
    1175 !             CALL MPL_RECV(IWIDE(1:10),KSOURCE=NPRCIDS(JROC),KTAG=1,CDSTRING='SUECRAD.W')
    1176             ENDIF
    1177             WRITE(NULOUT,'("SUECRAD: PROC=",I5,2X,"NRIWIDEN=",I3,2X,"NROWIDEN=",I3 )')&
    1178              & JROC,IWIDE(1),IWIDE(5) 
    1179             WRITE(NULOUT,'("SUECRAD: PROC=",I5,2X,"NRIWIDES=",I3,2X,"NROWIDES=",I3 )')&
    1180              & JROC,IWIDE(2),IWIDE(6) 
    1181             WRITE(NULOUT,'("SUECRAD: PROC=",I5,2X,"NRIWIDEW=",I3,2X,"NROWIDEW=",I3 )')&
    1182              & JROC,IWIDE(3),IWIDE(7) 
    1183             WRITE(NULOUT,'("SUECRAD: PROC=",I5,2X,"NRIWIDEE=",I3,2X,"NROWIDEE=",I3 )')&
    1184              & JROC,IWIDE(4),IWIDE(8) 
    1185             WRITE(NULOUT,'("SUECRAD: PROC=",I5,2X,"NARIB1=",I10,2X,"NAROB1=",I10 )')&
    1186              & JROC,IWIDE(9),IWIDE(10)
    1187             WRITE(NULOUT,'("")')
    1188             IF( IWIDE(1) > IRIWIDEMAXN ) IRIWIDEMAXN=IWIDE(1)
    1189             IF( IWIDE(2) > IRIWIDEMAXS ) IRIWIDEMAXS=IWIDE(2)
    1190             IF( IWIDE(3) > IRIWIDEMAXW ) IRIWIDEMAXW=IWIDE(3)
    1191             IF( IWIDE(4) > IRIWIDEMAXE ) IRIWIDEMAXE=IWIDE(4)
    1192             IF( IWIDE(5) > IROWIDEMAXN ) IROWIDEMAXN=IWIDE(5)
    1193             IF( IWIDE(6) > IROWIDEMAXS ) IROWIDEMAXS=IWIDE(6)
    1194             IF( IWIDE(7) > IROWIDEMAXW ) IROWIDEMAXW=IWIDE(7)
    1195             IF( IWIDE(8) > IROWIDEMAXE ) IROWIDEMAXE=IWIDE(8)
    1196             IF( IWIDE(9)  > IARIB1MAX  ) IARIB1MAX  =IWIDE(9)
    1197             IF( IWIDE(10) > IAROB1MAX  ) IAROB1MAX  =IWIDE(10)
    1198           ENDDO
    1199           WRITE(NULOUT,'("")')
    1200           WRITE(NULOUT,'("SUECRAD: NRIWIDEN(MAX)  =",I8)')IRIWIDEMAXN
    1201           WRITE(NULOUT,'("SUECRAD: NRIWIDES(MAX)  =",I8)')IRIWIDEMAXS
    1202           WRITE(NULOUT,'("SUECRAD: NRIWIDEW(MAX)  =",I8)')IRIWIDEMAXW
    1203           WRITE(NULOUT,'("SUECRAD: NRIWIDEE(MAX)  =",I8)')IRIWIDEMAXE
    1204           WRITE(NULOUT,'("SUECRAD: NROWIDEN(MAX)  =",I8)')IROWIDEMAXN
    1205           WRITE(NULOUT,'("SUECRAD: NROWIDES(MAX)  =",I8)')IROWIDEMAXS
    1206           WRITE(NULOUT,'("SUECRAD: NROWIDEW(MAX)  =",I8)')IROWIDEMAXW
    1207           WRITE(NULOUT,'("SUECRAD: NROWIDEE(MAX)  =",I8)')IROWIDEMAXE
    1208           WRITE(NULOUT,'("SUECRAD: NARIB1(MAX)    =",I10)')IARIB1MAX
    1209           WRITE(NULOUT,'("SUECRAD: NAROB1(MAX)    =",I10)')IAROB1MAX
    1210           WRITE(NULOUT,'("")')
    1211         ENDIF
    1212         CALL FLUSH(NULOUT)
    1213       ENDIF
    1214 
     1263    ! Read the absorption coefficient data and reduce from 256 to 140 g-points
     1264
     1265    CALL RRTM_INIT_140GP
     1266
     1267    INBLW = 16
     1268
     1269  ELSE
     1270    INBLW = 6
     1271
     1272  ENDIF
     1273
     1274  CALL SULWN
     1275  CALL SUSWN   (NTSW, NSW)
     1276  CALL SUCLOPN (NTSW, NSW, KLEV)
     1277
     1278  !-- routines specific to SRTM
     1279  IF (LSRTM) THEN
     1280    NTSW = 14
     1281    ISW = 14
     1282    CALL SRTM_INIT
     1283    CALL SUSRTAER
     1284    CALL SUSRTCOP
     1285    WRITE(UNIT = KULOUT, FMT = '(''SRTM Configuration'',L8,3I4)')LSRTM, NTSW, ISW, JPGPT
     1286
     1287  ELSE
     1288    IF (.NOT.LONEWSW .OR. ((NSW /= 2).AND.(NSW /= 4).AND.(NSW /= 6))) THEN
     1289      WRITE(UNIT = KULOUT, FMT = '(''Wrong SW Configuration'',L8,I3)')LONEWSW, NSW
    12151290    ENDIF
    1216 !    CALL GSTATS(1818,1)      MPL 2.12.08
    1217 
     1291
     1292    CALL SUSWN   (NTSW, NSW)
     1293    CALL SUAERSN (NTSW, NSW)
     1294  ENDIF
     1295  WRITE(UNIT = KULOUT, FMT = '('' NLW,NTSW,NSW SET EQUAL TO:'',3I3)') INBLW, NTSW, NSW
     1296
     1297
     1298  !-- routine specific to the UV processor
     1299  IF (LUVPROC) THEN
     1300    NUVTIM = NUVTIM * 86400
     1301    CALL SU_UVRAD (NUV)
     1302  ENDIF
     1303
     1304  !      ----------------------------------------------------------------
     1305
     1306  !*       6.    INITIALIZE AEROSOL OPTICAL PARAMETERS AND DISTRIBUTION
     1307  !              ------------------------------------------------------
     1308
     1309  !- LW optical properties
     1310  CALL SUAERL
     1311  !- SW optical properties moved above
     1312  !CALL SUAERSN (NTSW,NSW)
     1313
     1314  !- horizontal distribution
     1315  CALL SUAERH
     1316
     1317  !- vertical distribution
     1318  CALL SUAERV (KLEV, PETAH, &
     1319          & CVDAES, CVDAEL, CVDAEU, CVDAED, &
     1320          & RCTRBGA, RCVOBGA, RCSTBGA, RCAEOPS, RCAEOPL, RCAEOPU, &
     1321          & RCAEOPD, RCTRPT, RCAEADK, RCAEADM, RCAEROS &
     1322          &)
     1323
     1324  !-- Overlap function (only used if NOVLP=4)
     1325  ! Appel supprime par MPL (30042010) car NOVLP=4 pas utilise
     1326  ! sinon il faudrait calculer le geopotentiel STZ
     1327  !CALL SUOVLP ( KLEV )
     1328
     1329  !-- parameters for prognostic aerosols
     1330  CALL SU_AERW
     1331
     1332  !      ----------------------------------------------------------------
     1333
     1334  !*       7.    INITIALIZE SATELLITE GEOMETRICAL/RADIOMETRIC PARAMETERS
     1335  !              -------------------------------------------------------
     1336
     1337  IF (LEPHYS .AND. NMODE > 1) THEN
     1338    CALL SUSAT
     1339  ENDIF
     1340  !CALL GSTATS(1818,1)   MPL 2.12.08
     1341
     1342  !      ----------------------------------------------------------------
     1343
     1344  !*       8.    INITIALIZE CLIMATOLOGICAL OZONE DISTRIBUTION
     1345  !              --------------------------------------------
     1346  !                  (not done here!!!  called from APLPAR as it depends
     1347  !                     on model pressure levels!)
     1348
     1349  !      ----------------------------------------------------------------
     1350
     1351  !*       9.    SET UP MODEL CONFIGURATION FOR TIME-SPACE INTERPOLATION
     1352  !              -------------------------------------------------------
     1353
     1354  ZTSTEP = MAX(TSTEP, 1.0_JPRB)
     1355  ZSTPHR = 3600._JPRB / ZTSTEP
     1356  IRADFR = NRADFR
     1357  IF(NRADFR < 0) THEN
     1358    NRADFR = -NRADFR * ZSTPHR + 0.5_JPRB
     1359  ENDIF
     1360  NRADPFR = NRADPFR * NRADFR
     1361  IF (MOD(NRADPLA, 2) == 0.AND. NRADPLA /= 0) THEN
     1362    NRADPLA = NRADPLA + 1
     1363  ENDIF
     1364
     1365  IF(NRADUV < 0) THEN
     1366    NRADUV = -NRADUV * ZSTPHR + 0.5_JPRB
     1367  ENDIF
     1368
     1369  IST1HR = ZSTPHR + 0.05_JPRB
     1370  ISTNHR = NLNGR1H * ZSTPHR + 0.05_JPRB
     1371  IF (MOD(3600._JPRB, ZTSTEP) > 0.1_JPRB) THEN
     1372    801 CONTINUE
     1373    IST1HR = IST1HR + 1
     1374    IF (MOD(ISTNHR, IST1HR) /= 0) GO TO 801
     1375  ENDIF
     1376  IF (NRADFR == 1) THEN
     1377    NRADSFR = NRADFR
    12181378  ELSE
    1219 
    1220     WRITE(NULOUT,'("SUECRAD: INVALID VALUE FOR NRADINT=",I6)')NRADINT
    1221     CALL ABOR1('SUECRAD: NRADINT INVALID')
    1222 
    1223   ENDIF
    1224 
    1225 ENDIF              ! END OF LERADI BLOCK
    1226 
    1227 !      ----------------------------------------------------------------
    1228 
    1229 !*       4.    INITIALIZE RADIATION COEFFICIENTS.
    1230 !              ----------------------------------
    1231 
    1232 RCDAY   = RDAY * RG / RCPD
    1233 DIFF   = 1.66_JPRB
    1234 R10E   = 0.4342945_JPRB
    1235 
    1236 ! CALL GSTATS(1818,0)    MPL 2.12.08
    1237 CALL SURDI
    1238 
    1239 IF (NINHOM == 0) THEN
    1240   RLWINHF=1._JPRB
    1241   RSWINHF=1._JPRB
    1242 ENDIF
    1243 
    1244 !      ----------------------------------------------------------------
    1245 
    1246 !*       5.    INITIALIZE RADIATION ABSORPTION COEFFICIENTS
    1247 !              --------------------------------------------
    1248 
    1249 !*       5.1.  Initialization routine for RRTM
    1250 !              -------------------------------
    1251 
    1252 CALL SURRTAB
    1253 CALL SURRTPK
    1254 CALL SURRTRF
    1255 CALL SURRTFTR
    1256 
    1257 IF (LRRTM) THEN
    1258   IF (KLEV > JPLAY) THEN
    1259     WRITE(UNIT=KULOUT,&
    1260      & FMT='('' RRTM MAXIMUM NUMBER OF LAYERS IS REACHED'',&
    1261      & '' CALL ABORT'')') 
    1262     CALL ABOR1(' ABOR1 CALLED SUECRAD')
    1263   ENDIF
    1264    
    1265 ! Read the absorption coefficient data and reduce from 256 to 140 g-points
    1266 
    1267   CALL RRTM_INIT_140GP
    1268 
    1269   INBLW=16
    1270 
    1271 ELSE
    1272   INBLW=6
    1273 
    1274 ENDIF
    1275 
    1276 CALL SULWN
    1277 CALL SUSWN   (NTSW, NSW)
    1278 CALL SUCLOPN (NTSW, NSW, KLEV)
    1279 
    1280 !-- routines specific to SRTM
    1281 IF (LSRTM) THEN
    1282   NTSW=14
    1283   ISW =14
    1284   CALL SRTM_INIT
    1285   CALL SUSRTAER
    1286   CALL SUSRTCOP
    1287   WRITE(UNIT=KULOUT,FMT='(''SRTM Configuration'',L8,3I4)')LSRTM,NTSW,ISW,JPGPT
    1288 
    1289 ELSE
    1290   IF (.NOT.LONEWSW .OR. ((NSW /= 2).AND.(NSW /= 4).AND.(NSW /= 6)) ) THEN
    1291     WRITE(UNIT=KULOUT,FMT='(''Wrong SW Configuration'',L8,I3)')LONEWSW,NSW
    1292   ENDIF
    1293 
    1294   CALL SUSWN   (NTSW,NSW)
    1295   CALL SUAERSN (NTSW,NSW)
    1296 ENDIF
    1297 WRITE(UNIT=KULOUT,FMT='('' NLW,NTSW,NSW SET EQUAL TO:'',3I3)') INBLW,NTSW,NSW
    1298 
    1299 
    1300 !-- routine specific to the UV processor
    1301 IF (LUVPROC) THEN
    1302   NUVTIM = NUVTIM * 86400
    1303   CALL SU_UVRAD ( NUV )
    1304 ENDIF
    1305 
    1306 !      ----------------------------------------------------------------
    1307 
    1308 !*       6.    INITIALIZE AEROSOL OPTICAL PARAMETERS AND DISTRIBUTION
    1309 !              ------------------------------------------------------
    1310 
    1311 !- LW optical properties
    1312 CALL SUAERL
    1313 !- SW optical properties moved above
    1314 !CALL SUAERSN (NTSW,NSW)
    1315 
    1316 !- horizontal distribution     
    1317 CALL SUAERH
    1318 
    1319 !- vertical distribution
    1320 CALL SUAERV ( KLEV  , PETAH,&
    1321  & CVDAES , CVDAEL , CVDAEU , CVDAED,&
    1322  & RCTRBGA, RCVOBGA, RCSTBGA, RCAEOPS, RCAEOPL, RCAEOPU,&
    1323  & RCAEOPD, RCTRPT , RCAEADK, RCAEADM, RCAEROS &
    1324  & ) 
    1325 
    1326 !-- Overlap function (only used if NOVLP=4)
    1327 ! Appel supprime par MPL (30042010) car NOVLP=4 pas utilise
    1328 ! sinon il faudrait calculer le geopotentiel STZ
    1329 !CALL SUOVLP ( KLEV )
    1330 
    1331 !-- parameters for prognostic aerosols
    1332 CALL SU_AERW
    1333 
    1334 !      ----------------------------------------------------------------
    1335 
    1336 !*       7.    INITIALIZE SATELLITE GEOMETRICAL/RADIOMETRIC PARAMETERS
    1337 !              -------------------------------------------------------
    1338 
    1339 IF (LEPHYS .AND. NMODE > 1) THEN
    1340   CALL SUSAT
    1341 ENDIF
    1342 !CALL GSTATS(1818,1)   MPL 2.12.08
    1343 
    1344 !      ----------------------------------------------------------------
    1345 
    1346 !*       8.    INITIALIZE CLIMATOLOGICAL OZONE DISTRIBUTION
    1347 !              --------------------------------------------
    1348 !                  (not done here!!!  called from APLPAR as it depends
    1349 !                     on model pressure levels!)
    1350 
    1351 !      ----------------------------------------------------------------
    1352 
    1353 !*       9.    SET UP MODEL CONFIGURATION FOR TIME-SPACE INTERPOLATION
    1354 !              -------------------------------------------------------
    1355 
    1356 ZTSTEP=MAX(TSTEP,1.0_JPRB)
    1357 ZSTPHR=3600._JPRB/ZTSTEP
    1358 IRADFR=NRADFR
    1359 IF(NRADFR < 0) THEN
    1360   NRADFR=-NRADFR*ZSTPHR+0.5_JPRB
    1361 ENDIF
    1362 NRADPFR=NRADPFR*NRADFR
    1363 IF (MOD(NRADPLA,2) == 0.AND. NRADPLA /= 0) THEN
    1364   NRADPLA=NRADPLA+1
    1365 ENDIF
    1366 
    1367 IF(NRADUV < 0) THEN
    1368   NRADUV=-NRADUV*ZSTPHR+0.5_JPRB
    1369 ENDIF
    1370 
    1371 IST1HR=ZSTPHR+0.05_JPRB
    1372 ISTNHR=  NLNGR1H *ZSTPHR+0.05_JPRB
    1373 IF (MOD(3600._JPRB,ZTSTEP) > 0.1_JPRB) THEN
    1374   801 CONTINUE
    1375   IST1HR=IST1HR+1
    1376   IF (MOD(ISTNHR,IST1HR) /= 0) GO TO 801
    1377 ENDIF
    1378 IF (NRADFR == 1) THEN
    1379   NRADSFR=NRADFR
    1380 ELSE
    1381   NRADSFR=IST1HR
    1382 ENDIF
    1383 NRADNFR=NRADFR
    1384 
    1385 IF(LRAYFM) THEN
    1386   NRPROMA=NDLON+6+(1-MOD(NDLON,2))
    1387 ENDIF
    1388 
    1389 !      ----------------------------------------------------------------
    1390 
    1391 !*       10.    ALLOCATE WORK ARRAYS
    1392 !               --------------------
    1393 
    1394 IU = NULOUT
    1395 LLP = NPRINTLEV >= 1.OR. LALLOPR
    1396 
    1397 IF (LEPHYS) THEN
    1398   ALLOCATE(EMTD(NPROMA,NFLEVG+1,NGPBLKS))
    1399   IF(LLP)WRITE(IU,9) 'EMTD     ',SIZE(EMTD     ),SHAPE(EMTD     )
    1400   ALLOCATE(TRSW(NPROMA,NFLEVG+1,NGPBLKS))
    1401   IF(LLP)WRITE(IU,9) 'TRSW     ',SIZE(TRSW     ),SHAPE(TRSW     )
    1402   ALLOCATE(EMTC(NPROMA,NFLEVG+1,NGPBLKS))
    1403   IF(LLP)WRITE(IU,9) 'EMTC     ',SIZE(EMTC     ),SHAPE(EMTC     )
    1404   ALLOCATE(TRSC(NPROMA,NFLEVG+1,NGPBLKS))
    1405   IF(LLP)WRITE(IU,9) 'TRSC     ',SIZE(TRSC     ),SHAPE(TRSC     )
    1406   ALLOCATE(SRSWD(NPROMA,NGPBLKS))
    1407   IF(LLP)WRITE(IU,9) 'SRSWD    ',SIZE(SRSWD    ),SHAPE(SRSWD    )
    1408   ALLOCATE(SRLWD(NPROMA,NGPBLKS))
    1409   IF(LLP)WRITE(IU,9) 'SRLWD    ',SIZE(SRLWD    ),SHAPE(SRLWD    )
    1410   ALLOCATE(SRSWDCS(NPROMA,NGPBLKS))
    1411   IF(LLP)WRITE(IU,9) 'SRSWDCS  ',SIZE(SRSWDCS  ),SHAPE(SRSWDCS  )
    1412   ALLOCATE(SRLWDCS(NPROMA,NGPBLKS))
    1413   IF(LLP)WRITE(IU,9) 'SRLWDCS  ',SIZE(SRLWDCS  ),SHAPE(SRLWDCS  )
    1414   ALLOCATE(SRSWDV(NPROMA,NGPBLKS))
    1415   IF(LLP)WRITE(IU,9) 'SRSWDV   ',SIZE(SRSWDV   ),SHAPE(SRSWDV   )
    1416   ALLOCATE(SRSWDUV(NPROMA,NGPBLKS))
    1417   IF(LLP)WRITE(IU,9) 'SRSWDUV  ',SIZE(SRSWDUV  ),SHAPE(SRSWDUV  )
    1418   ALLOCATE(EDRO(NPROMA,NGPBLKS))
    1419   IF(LLP)WRITE(IU,9) 'EDRO     ',SIZE(EDRO     ),SHAPE(EDRO     )
    1420   ALLOCATE(SRSWPAR(NPROMA,NGPBLKS))
    1421   IF(LLP)WRITE(IU,9) 'SRSWPAR  ',SIZE(SRSWPAR  ),SHAPE(SRSWPAR  )
    1422   ALLOCATE(SRSWUVB(NPROMA,NGPBLKS))
    1423   IF(LLP)WRITE(IU,9) 'SRSWUVB  ',SIZE(SRSWUVB  ),SHAPE(SRSWUVB  )
    1424 
    1425 ELSEIF(LMPHYS .AND. (LRAYFM.OR.LRAYFM15)) THEN
    1426   ALLOCATE(EMTD(NPROMA,NFLEVG+1,NGPBLKS))
    1427   IF(LLP)WRITE(IU,9) 'EMTD     ',SIZE(EMTD     ),SHAPE(EMTD     )
    1428   ALLOCATE(TRSW(NPROMA,NFLEVG+1,NGPBLKS))
    1429   IF(LLP)WRITE(IU,9) 'TRSW     ',SIZE(TRSW     ),SHAPE(TRSW     )
    1430   ALLOCATE(EMTU(NPROMA,NFLEVG+1,NGPBLKS))
    1431   IF(LLP)WRITE(IU,9) 'EMTC     ',SIZE(EMTU     ),SHAPE(EMTU     )
    1432   ALLOCATE(RMOON(NPROMA,NGPBLKS))
    1433   IF(LLP)WRITE(IU,9) 'RMOON    ',SIZE(RMOON    ),SHAPE(RMOON    )
    1434 ENDIF
    1435 ALLOCATE(SRSWPARC(NPROMA,NGPBLKS))
    1436 IF(LLP)WRITE(IU,9) 'SRSWPARC ',SIZE(SRSWPARC ),SHAPE(SRSWPARC )
    1437 ALLOCATE(SRSWTINC(NPROMA,NGPBLKS))
    1438 IF(LLP)WRITE(IU,9) 'SRSWTINC ',SIZE(SRSWTINC ),SHAPE(SRSWTINC )
    1439 
    1440 9 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8)
    1441 
    1442 !      ----------------------------------------------------------------
    1443 
    1444 !*       10.    PRINT FINAL VALUES.
    1445 !               -------------------
    1446 
    1447 IF (LOUTPUT) THEN
    1448   WRITE(UNIT=KULOUT,FMT='('' COMMON YOERAD '')')
    1449   WRITE(UNIT=KULOUT,FMT='('' LERADI  = '',L5 &
    1450    & ,'' LERAD1H = '',L5,'' LECO2VAR= '',L5,'' LHGHG = '',L5 &
    1451    & ,'' NLNGR1H = '',I2,'' NRADSFR = '',I2)')&
    1452    & LERADI,LERAD1H,LECO2VAR,LHGHG,NLNGR1H,NRADSFR 
    1453   WRITE(UNIT=KULOUT,FMT='('' LEPO3RA  = '',L5,'' YO3%LGP = '',L5 )') LEPO3RA,YO3%LGP
    1454   WRITE(UNIT=KULOUT,FMT='('' NRADFR  = '',I2 &
    1455    & ,'' NRADPFR = '',I3 &
    1456    & ,'' NRADPLA = '',I2 &
    1457    & ,'' NRINT   = '',I1 &
    1458    & ,'' NRPROMA = '',I5 &
    1459    & )')&
    1460    & NRADFR,NRADPFR,NRADPLA,NRINT, NRPROMA
    1461   WRITE(UNIT=KULOUT,FMT='('' LERADHS= '',L5 &
    1462    & ,'' LRRTM = '',L5 &
    1463    & ,'' LSRTM = '',L5 &
    1464    & ,'' NMODE = '',I1 &
    1465    & ,'' NOZOCL= '',I1 &
    1466    & ,'' NAER  = '',I1 &
    1467    & ,'' NHINCSOL='',I2 &
    1468    & )')&
    1469    & LERADHS,LRRTM,LSRTM,NMODE,NOZOCL,NAER,NHINCSOL
    1470   IF (.NOT.LHGHG .AND. .NOT.LECO2VAR) WRITE(UNIT=KULOUT,FMT='('' RCCO2= '',E10.3 &
    1471     &,'' RCCH4= '',E10.3,'' RCN2O= '',E10.3,'' RCCFC11= '',E10.3,'' RCFC12= '',E10.3 &
    1472     &)')&
    1473     & RCCO2,RCCH4,RCN2O,RCCFC11,RCCFC12
    1474   WRITE(UNIT=KULOUT,FMT='('' NINHOM = '',I1 &
    1475    & ,'' NLAYINH='',I1   &
    1476    & ,'' RLWINHF='',F4.2 &
    1477    & ,'' RSWINHF='',F4.2 &
    1478    & )')&
    1479    & NINHOM,NLAYINH,RLWINHF,RSWINHF 
    1480   IF (NPERTAER /= 0 .OR. NPERTOZ /= 0) THEN
    1481     WRITE(UNIT=KULOUT,FMT='('' NPERTAER= '',I2 &
    1482    & ,'' LNOTROAER='',L5 &
    1483    & ,'' NPERTOZ = '',I1 &
    1484    & ,'' RPERTOZ = '',F5.0 &
    1485    & )')&
    1486    & NPERTAER,LNOTROAER,NPERTOZ,RPERTOZ
    1487   ENDIF
    1488   WRITE(UNIT=KULOUT,FMT='('' NRADINT = '',I2)')NRADINT
    1489   WRITE(UNIT=KULOUT,FMT='('' NRADRES = '',I4)')NRADRES
    1490   WRITE(UNIT=KULOUT,FMT='('' LRADONDEM = '',L5)')LRADONDEM
    1491   IF( NRADINT > 0 )THEN
    1492     IDIR=LEN_TRIM(CRTABLEDIR)
    1493     IFIL=LEN_TRIM(CRTABLEFIL)
    1494     WRITE(UNIT=KULOUT,FMT='('' CRTABLEDIR = '',A,'' CRTABLEFIL = '',A)')&
    1495      & CRTABLEDIR(1:IDIR),CRTABLEFIL(1:IFIL) 
    1496   ENDIF
    1497   WRITE(UNIT=KULOUT,FMT='('' LCCNL = '',L5 &
    1498    & ,'' LCCNO = '',L5 &
    1499    & ,'' RCCNLND= '',F5.0 &
    1500    & ,'' RCCNSEA= '',F5.0 &
    1501    & ,'' LE4ALB = '',L5 &
    1502    &)')&
    1503    & LCCNL,LCCNO,RCCNLND,RCCNSEA,LE4ALB
    1504   IF (LHVOLCA) THEN
    1505     WRITE(UNIT=KULOUT,FMT='('' HISTORY OF VOLCANIC AEROSOLS= '',L5)')LHVOLCA
    1506   ENDIF
    1507   WRITE(UNIT=KULOUT,FMT='('' LONEWSW= '',L5 &
    1508    & ,'' NRADIP = '',I1 &
    1509    & ,'' NRADLP = '',I1 &
    1510    & ,'' NICEOPT= '',I1 &
    1511    & ,'' NLIQOPT= '',I1 &
    1512    & ,'' LDIFFC = '',L5 &
    1513    & )')&
    1514    & LONEWSW,NRADIP,NRADLP,NICEOPT,NLIQOPT,LDIFFC
    1515   WRITE(UNIT=KULOUT,FMT='('' WARNING! CLOUD OVERLAP ASSUMPT. IS''&
    1516    & ,'' NOVLP   = '',I2 &
    1517    & )')&
    1518    & NOVLP 
    1519   IF (LUVPROC) THEN
    1520     IDAYUV=NUVTIM/86400
    1521     WRITE(UNIT=KULOUT,FMT='('' LUVPROC = '',L5 &
    1522    & ,'' LUVTDEP= '',L5 &
    1523    & ,'' NRADUV = '',I2 &
    1524    & ,'' NUV = '',I2 &
    1525    & ,'' NDAYUV = '',I5 &
    1526    & ,'' RMUZUV = '',E9.3 &
    1527    & )')&
    1528    & LUVPROC,LUVTDEP,NRADUV,NUV,IDAYUV,RMUZUV
    1529     WRITE(UNIT=KULOUT,FMT='('' RUVLAM = '',24F6.1)') (RUVLAM(JUV),JUV=1,NUV)
    1530     WRITE(UNIT=KULOUT,FMT='('' JUVLAM = '',24(3X,I1,2X))') (JUVLAM(JUV),JUV=1,NUV)
    1531   ENDIF
    1532   WRITE(UNIT=KULOUT,FMT='('' NMCICA= '',I2 &
    1533    & )')&
    1534    & NMCICA
    1535 ENDIF
    1536 
    1537 !     ------------------------------------------------------------------
    1538 
    1539 
    1540 IF (LHOOK) CALL DR_HOOK('SUECRAD',1,ZHOOK_HANDLE)
     1379    NRADSFR = IST1HR
     1380  ENDIF
     1381  NRADNFR = NRADFR
     1382
     1383  IF(LRAYFM) THEN
     1384    NRPROMA = NDLON + 6 + (1 - MOD(NDLON, 2))
     1385  ENDIF
     1386
     1387  !      ----------------------------------------------------------------
     1388
     1389  !*       10.    ALLOCATE WORK ARRAYS
     1390  !               --------------------
     1391
     1392  IU = NULOUT
     1393  LLP = NPRINTLEV >= 1.OR. LALLOPR
     1394
     1395  IF (LEPHYS) THEN
     1396    ALLOCATE(EMTD(NPROMA, NFLEVG + 1, NGPBLKS))
     1397    IF(LLP)WRITE(IU, 9) 'EMTD     ', SIZE(EMTD), SHAPE(EMTD)
     1398    ALLOCATE(TRSW(NPROMA, NFLEVG + 1, NGPBLKS))
     1399    IF(LLP)WRITE(IU, 9) 'TRSW     ', SIZE(TRSW), SHAPE(TRSW)
     1400    ALLOCATE(EMTC(NPROMA, NFLEVG + 1, NGPBLKS))
     1401    IF(LLP)WRITE(IU, 9) 'EMTC     ', SIZE(EMTC), SHAPE(EMTC)
     1402    ALLOCATE(TRSC(NPROMA, NFLEVG + 1, NGPBLKS))
     1403    IF(LLP)WRITE(IU, 9) 'TRSC     ', SIZE(TRSC), SHAPE(TRSC)
     1404    ALLOCATE(SRSWD(NPROMA, NGPBLKS))
     1405    IF(LLP)WRITE(IU, 9) 'SRSWD    ', SIZE(SRSWD), SHAPE(SRSWD)
     1406    ALLOCATE(SRLWD(NPROMA, NGPBLKS))
     1407    IF(LLP)WRITE(IU, 9) 'SRLWD    ', SIZE(SRLWD), SHAPE(SRLWD)
     1408    ALLOCATE(SRSWDCS(NPROMA, NGPBLKS))
     1409    IF(LLP)WRITE(IU, 9) 'SRSWDCS  ', SIZE(SRSWDCS), SHAPE(SRSWDCS)
     1410    ALLOCATE(SRLWDCS(NPROMA, NGPBLKS))
     1411    IF(LLP)WRITE(IU, 9) 'SRLWDCS  ', SIZE(SRLWDCS), SHAPE(SRLWDCS)
     1412    ALLOCATE(SRSWDV(NPROMA, NGPBLKS))
     1413    IF(LLP)WRITE(IU, 9) 'SRSWDV   ', SIZE(SRSWDV), SHAPE(SRSWDV)
     1414    ALLOCATE(SRSWDUV(NPROMA, NGPBLKS))
     1415    IF(LLP)WRITE(IU, 9) 'SRSWDUV  ', SIZE(SRSWDUV), SHAPE(SRSWDUV)
     1416    ALLOCATE(EDRO(NPROMA, NGPBLKS))
     1417    IF(LLP)WRITE(IU, 9) 'EDRO     ', SIZE(EDRO), SHAPE(EDRO)
     1418    ALLOCATE(SRSWPAR(NPROMA, NGPBLKS))
     1419    IF(LLP)WRITE(IU, 9) 'SRSWPAR  ', SIZE(SRSWPAR), SHAPE(SRSWPAR)
     1420    ALLOCATE(SRSWUVB(NPROMA, NGPBLKS))
     1421    IF(LLP)WRITE(IU, 9) 'SRSWUVB  ', SIZE(SRSWUVB), SHAPE(SRSWUVB)
     1422
     1423  ELSEIF(LMPHYS .AND. (LRAYFM.OR.LRAYFM15)) THEN
     1424    ALLOCATE(EMTD(NPROMA, NFLEVG + 1, NGPBLKS))
     1425    IF(LLP)WRITE(IU, 9) 'EMTD     ', SIZE(EMTD), SHAPE(EMTD)
     1426    ALLOCATE(TRSW(NPROMA, NFLEVG + 1, NGPBLKS))
     1427    IF(LLP)WRITE(IU, 9) 'TRSW     ', SIZE(TRSW), SHAPE(TRSW)
     1428    ALLOCATE(EMTU(NPROMA, NFLEVG + 1, NGPBLKS))
     1429    IF(LLP)WRITE(IU, 9) 'EMTC     ', SIZE(EMTU), SHAPE(EMTU)
     1430    ALLOCATE(RMOON(NPROMA, NGPBLKS))
     1431    IF(LLP)WRITE(IU, 9) 'RMOON    ', SIZE(RMOON), SHAPE(RMOON)
     1432  ENDIF
     1433  ALLOCATE(SRSWPARC(NPROMA, NGPBLKS))
     1434  IF(LLP)WRITE(IU, 9) 'SRSWPARC ', SIZE(SRSWPARC), SHAPE(SRSWPARC)
     1435  ALLOCATE(SRSWTINC(NPROMA, NGPBLKS))
     1436  IF(LLP)WRITE(IU, 9) 'SRSWTINC ', SIZE(SRSWTINC), SHAPE(SRSWTINC)
     1437
     1438  9 FORMAT(1X, 'ARRAY ', A10, ' ALLOCATED ', 8I8)
     1439
     1440  !      ----------------------------------------------------------------
     1441
     1442  !*       10.    PRINT FINAL VALUES.
     1443  !               -------------------
     1444
     1445  IF (LOUTPUT) THEN
     1446    WRITE(UNIT = KULOUT, FMT = '('' COMMON YOERAD '')')
     1447    WRITE(UNIT = KULOUT, FMT = '('' LERADI  = '',L5 &
     1448            & ,'' LERAD1H = '',L5,'' LECO2VAR= '',L5,'' LHGHG = '',L5 &
     1449            & ,'' NLNGR1H = '',I2,'' NRADSFR = '',I2)')&
     1450            & LERADI, LERAD1H, LECO2VAR, LHGHG, NLNGR1H, NRADSFR
     1451    WRITE(UNIT = KULOUT, FMT = '('' LEPO3RA  = '',L5,'' YO3%LGP = '',L5 )') LEPO3RA, YO3%LGP
     1452    WRITE(UNIT = KULOUT, FMT = '('' NRADFR  = '',I2 &
     1453            & ,'' NRADPFR = '',I3 &
     1454            & ,'' NRADPLA = '',I2 &
     1455            & ,'' NRINT   = '',I1 &
     1456            & ,'' NRPROMA = '',I5 &
     1457            & )')&
     1458            & NRADFR, NRADPFR, NRADPLA, NRINT, NRPROMA
     1459    WRITE(UNIT = KULOUT, FMT = '('' LERADHS= '',L5 &
     1460            & ,'' LRRTM = '',L5 &
     1461            & ,'' LSRTM = '',L5 &
     1462            & ,'' NMODE = '',I1 &
     1463            & ,'' NOZOCL= '',I1 &
     1464            & ,'' NAER  = '',I1 &
     1465            & ,'' NHINCSOL='',I2 &
     1466            & )')&
     1467            & LERADHS, LRRTM, LSRTM, NMODE, NOZOCL, NAER, NHINCSOL
     1468    IF (.NOT.LHGHG .AND. .NOT.LECO2VAR) WRITE(UNIT = KULOUT, FMT = '('' RCCO2= '',E10.3 &
     1469            &,'' RCCH4= '',E10.3,'' RCN2O= '',E10.3,'' RCCFC11= '',E10.3,'' RCFC12= '',E10.3 &
     1470            &)')&
     1471            & RCCO2, RCCH4, RCN2O, RCCFC11, RCCFC12
     1472    WRITE(UNIT = KULOUT, FMT = '('' NINHOM = '',I1 &
     1473            & ,'' NLAYINH='',I1   &
     1474            & ,'' RLWINHF='',F4.2 &
     1475            & ,'' RSWINHF='',F4.2 &
     1476            & )')&
     1477            & NINHOM, NLAYINH, RLWINHF, RSWINHF
     1478    IF (NPERTAER /= 0 .OR. NPERTOZ /= 0) THEN
     1479      WRITE(UNIT = KULOUT, FMT = '('' NPERTAER= '',I2 &
     1480              & ,'' LNOTROAER='',L5 &
     1481              & ,'' NPERTOZ = '',I1 &
     1482              & ,'' RPERTOZ = '',F5.0 &
     1483              & )')&
     1484              & NPERTAER, LNOTROAER, NPERTOZ, RPERTOZ
     1485    ENDIF
     1486    WRITE(UNIT = KULOUT, FMT = '('' NRADINT = '',I2)')NRADINT
     1487    WRITE(UNIT = KULOUT, FMT = '('' NRADRES = '',I4)')NRADRES
     1488    WRITE(UNIT = KULOUT, FMT = '('' LRADONDEM = '',L5)')LRADONDEM
     1489    IF(NRADINT > 0)THEN
     1490      IDIR = LEN_TRIM(CRTABLEDIR)
     1491      IFIL = LEN_TRIM(CRTABLEFIL)
     1492      WRITE(UNIT = KULOUT, FMT = '('' CRTABLEDIR = '',A,'' CRTABLEFIL = '',A)')&
     1493              & CRTABLEDIR(1:IDIR), CRTABLEFIL(1:IFIL)
     1494    ENDIF
     1495    WRITE(UNIT = KULOUT, FMT = '('' LCCNL = '',L5 &
     1496            & ,'' LCCNO = '',L5 &
     1497            & ,'' RCCNLND= '',F5.0 &
     1498            & ,'' RCCNSEA= '',F5.0 &
     1499            & ,'' LE4ALB = '',L5 &
     1500            &)')&
     1501            & LCCNL, LCCNO, RCCNLND, RCCNSEA, LE4ALB
     1502    IF (LHVOLCA) THEN
     1503      WRITE(UNIT = KULOUT, FMT = '('' HISTORY OF VOLCANIC AEROSOLS= '',L5)')LHVOLCA
     1504    ENDIF
     1505    WRITE(UNIT = KULOUT, FMT = '('' LONEWSW= '',L5 &
     1506            & ,'' NRADIP = '',I1 &
     1507            & ,'' NRADLP = '',I1 &
     1508            & ,'' NICEOPT= '',I1 &
     1509            & ,'' NLIQOPT= '',I1 &
     1510            & ,'' LDIFFC = '',L5 &
     1511            & )')&
     1512            & LONEWSW, NRADIP, NRADLP, NICEOPT, NLIQOPT, LDIFFC
     1513    WRITE(UNIT = KULOUT, FMT = '('' WARNING! CLOUD OVERLAP ASSUMPT. IS''&
     1514            & ,'' NOVLP   = '',I2 &
     1515            & )')&
     1516            & NOVLP
     1517    IF (LUVPROC) THEN
     1518      IDAYUV = NUVTIM / 86400
     1519      WRITE(UNIT = KULOUT, FMT = '('' LUVPROC = '',L5 &
     1520              & ,'' LUVTDEP= '',L5 &
     1521              & ,'' NRADUV = '',I2 &
     1522              & ,'' NUV = '',I2 &
     1523              & ,'' NDAYUV = '',I5 &
     1524              & ,'' RMUZUV = '',E9.3 &
     1525              & )')&
     1526              & LUVPROC, LUVTDEP, NRADUV, NUV, IDAYUV, RMUZUV
     1527      WRITE(UNIT = KULOUT, FMT = '('' RUVLAM = '',24F6.1)') (RUVLAM(JUV), JUV = 1, NUV)
     1528      WRITE(UNIT = KULOUT, FMT = '('' JUVLAM = '',24(3X,I1,2X))') (JUVLAM(JUV), JUV = 1, NUV)
     1529    ENDIF
     1530    WRITE(UNIT = KULOUT, FMT = '('' NMCICA= '',I2 &
     1531            & )')&
     1532            & NMCICA
     1533  ENDIF
     1534
     1535  !     ------------------------------------------------------------------
     1536
     1537  IF (LHOOK) CALL DR_HOOK('SUECRAD', 1, ZHOOK_HANDLE)
    15411538END SUBROUTINE SUECRAD

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/suecrad15.F90

    r1990 r5154  
    7878USE YOMPRAD  , ONLY : LODBGRADI,LODBGRADL
    7979USE YOMRADF  , ONLY : EMTD     ,EMTU      ,TRSW    ,RMOON
     80USE lmdz_clesphys
    8081
    8182IMPLICIT NONE
    82 
    83 include "clesphys.h"
    8483
    8584INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/suphec.F90

    r5133 r5154  
    8888USE YOMCT0  , ONLY  : LSCMEC   ,LROUGH   ,REXTZ0M  ,REXTZ0H
    8989USE lmdz_vertical_layers, ONLY: ap,bp
     90USE lmdz_clesphys
     91USE lmdz_yoethf
    9092
    9193IMPLICIT NONE
    92 include "YOETHF.h"
    93 include "clesphys.h"
    9494
    9595INTEGER(KIND=JPIM),INTENT(IN)    :: KULOUT

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/sw.F90

    r5133 r5154  
    7474! NSW mis dans .def MPL 20140211
    7575USE lmdz_writefield_phy, ONLY: writefield_phy
     76USE lmdz_clesphys
    7677
    7778IMPLICIT NONE
    78 
    79 include "clesphys.h"
    8079
    8180integer, save :: icount=0

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/sw.intfb.h

    r1990 r5154  
    1313 & )
    1414USE PARKIND1 ,ONLY : JPIM ,JPRB
    15 include "clesphys.h"   
     15USE lmdz_clesphys
     16
    1617INTEGER(KIND=JPIM),INTENT(IN) :: KLON
    1718INTEGER(KIND=JPIM),INTENT(IN) :: KLEV

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/sw1s.F90

    r5133 r5154  
    7373! NSW mis dans .def MPL 20140211
    7474USE lmdz_writefield_phy, ONLY: writefield_phy
     75USE lmdz_clesphys
    7576
    7677IMPLICIT NONE
    77 
    78 include "clesphys.h"
    7978
    8079INTEGER(KIND=JPIM),INTENT(IN)    :: KLON

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/sw1s.intfb.h

    r1990 r5154  
    88 & )
    99USE PARKIND1 ,ONLY : JPIM ,JPRB
    10 include "clesphys.h"
     10USE lmdz_clesphys
     11
    1112INTEGER(KIND=JPIM),INTENT(IN) :: KLON
    1213INTEGER(KIND=JPIM),INTENT(IN) :: KLEV

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/swclr.F90

    r2044 r5154  
    7070USE YOERDI   , ONLY : REPCLC
    7171USE YOERDU   , ONLY : REPSCT
     72USE lmdz_clesphys
    7273
    7374IMPLICIT NONE
    74 INCLUDE "clesphys.h"
    7575
    7676INTEGER(KIND=JPIM),INTENT(IN)    :: KLON

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/swclr.intfb.h

    r1990 r5154  
    88USE PARKIND1 ,ONLY : JPIM ,JPRB
    99USE YOERAD , ONLY : NOVLP
    10 include "clesphys.h"
     10USE lmdz_clesphys
     11
    1112INTEGER(KIND=JPIM),INTENT(IN) :: KLON
    1213INTEGER(KIND=JPIM),INTENT(IN) :: KLEV

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/swni.F90

    r5133 r5154  
    8181USE YOERDU   , ONLY : REPLOG   ,REPSCQ   ,REPSC
    8282USE lmdz_writefield_phy, ONLY: writefield_phy
     83USE lmdz_clesphys
    8384
    8485IMPLICIT NONE
    85 
    86 include "clesphys.h"
    8786
    8887character*1 str1

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/swni.intfb.h

    r1990 r5154  
    99USE PARKIND1 ,ONLY : JPIM ,JPRB
    1010USE YOERAD , ONLY : NOVLP
    11 include "clesphys.h"
     11USE lmdz_clesphys
     12
    1213INTEGER(KIND=JPIM),INTENT(IN) :: KLON
    1314INTEGER(KIND=JPIM),INTENT(IN) :: KLEV

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/swr.F90

    r5133 r5154  
    6666USE YOEOVLP  , ONLY : RA1OVLP
    6767USE lmdz_writefield_phy, ONLY: writefield_phy
     68USE lmdz_clesphys
    6869
    6970IMPLICIT NONE
    7071
    71 include "clesphys.h"
    72 INTEGER(KIND=JPIM),INTENT(IN)    :: KLON
     72INTEGER(KIND=JPIM),INTENT(IN)    :: KLON
    7373INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
    7474INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/swr.intfb.h

    r1990 r5154  
    88USE PARKIND1 ,ONLY : JPIM ,JPRB
    99USE YOERAD , ONLY : NOVLP
    10 include "clesphys.h"
     10USE lmdz_clesphys
     11
    1112INTEGER(KIND=JPIM),INTENT(IN) :: KLON
    1213INTEGER(KIND=JPIM),INTENT(IN) :: KLEV

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/swu.F90

    r1990 r5154  
    6464 & RTDH2O   ,RTDUMG   ,RTH2O    ,RTUMG 
    6565USE YOEOVLP  , ONLY : RA1OVLP
     66USE lmdz_clesphys
    6667
    6768IMPLICIT NONE
    6869
    69 include "clesphys.h"
    70 INTEGER(KIND=JPIM),INTENT(IN)    :: KLON
     70INTEGER(KIND=JPIM),INTENT(IN)    :: KLON
    7171INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
    7272INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/swu.intfb.h

    r1990 r5154  
    77USE PARKIND1 ,ONLY : JPIM ,JPRB
    88USE YOERAD , ONLY : NOVLP
    9 include "clesphys.h"
     9USE lmdz_clesphys
     10
    1011INTEGER(KIND=JPIM),INTENT(IN) :: KLON
    1112INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
Note: See TracChangeset for help on using the changeset viewer.