Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/dustemission_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/dustemission_mod.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/dustemission_mod.F90	(revision 5133)
@@ -172,5 +172,5 @@
   USE dimphy
   USE infotrac
-  USE lmdz_write_field_phy
+  USE lmdz_writefield_phy
   USE lmdz_grid_phy
   USE lmdz_phys_para
@@ -279,5 +279,5 @@
   USE dimphy
   USE infotrac
-  USE lmdz_write_field_phy
+  USE lmdz_writefield_phy
   USE lmdz_grid_phy
   USE lmdz_phys_para
@@ -519,5 +519,5 @@
   USE dimphy
   USE infotrac
-  USE lmdz_write_field_phy
+  USE lmdz_writefield_phy
   USE lmdz_grid_phy
   USE lmdz_phys_para
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/phytracr_spl_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/phytracr_spl_mod.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/phytracr_spl_mod.F90	(revision 5133)
@@ -790,5 +790,5 @@
     USE infotrac
     USE indice_sol_mod
-    USE lmdz_write_field_phy
+    USE lmdz_writefield_phy
 
     USE lmdz_phys_transfert_para
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/satellite_out_spla.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/satellite_out_spla.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/satellite_out_spla.F90	(revision 5133)
@@ -5,5 +5,5 @@
   USE dimphy
   USE IOIPSL
-  USE lmdz_write_field_phy
+  USE lmdz_writefield_phy
 
   IMPLICIT NONE
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/cosp_output_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/cosp_output_mod.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/cosp_output_mod.F90	(revision 5133)
@@ -234,5 +234,5 @@
   USE phys_cal_mod
   USE time_phylmdz_mod, ONLY: day_ref, annee_ref, day_ini, start_time, itau_phy
-  USE print_control_mod, ONLY: lunout
+  USE lmdz_print_control, ONLY: lunout
   ! ug Pour les sorties XIOS
   USE wxios
@@ -260,5 +260,5 @@
 !!! Variables d'entree
 
-  ! ug Variables utilisées pour récupérer le calendrier pour xios
+  ! ug Variables utilis�es pour r�cup�rer le calendrier pour xios
   INTEGER :: x_an, x_mois, x_jour
   REAL :: x_heure
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/cosp_output_write_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/cosp_output_write_mod.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/cosp_output_write_mod.F90	(revision 5133)
@@ -25,5 +25,5 @@
     USE ioipsl
     USE time_phylmdz_mod, ONLY: itau_phy, start_time, day_step_phy
-    USE print_control_mod, ONLY: lunout,prt_level
+    USE lmdz_print_control, ONLY: lunout,prt_level
     USE wxios, only: wxios_closedef
     USE lmdz_xios, only: xios_update_calendar, xios_field_is_active, using_xios
@@ -441,7 +441,7 @@
     USE dimphy
     use iophy
-    USE mod_phys_lmdz_para
-    USE mod_grid_phy_lmdz, ONLY: nbp_lon
-    USE print_control_mod, ONLY: lunout,prt_level
+    USE lmdz_phys_para
+    USE lmdz_grid_phy, ONLY: nbp_lon
+    USE lmdz_print_control, ONLY: lunout,prt_level
     USE wxios
 
@@ -456,6 +456,6 @@
     CHARACTER(LEN=20) :: typeecrit
 
-    ! ug On rÃ©cupÃ¨re le type Ã©crit de la structure:
-    !       Assez moche, Ã|  refaire si meilleure mÃ©thode...
+    ! ug On récupère le type écrit de la structure:
+    !       Assez moche, �|  refaire si meilleure méthode...
     IF (INDEX(var%cosp_typeecrit(iff), "once") > 0) THEN
        typeecrit = 'once'
@@ -502,7 +502,7 @@
     USE dimphy
     use iophy
-    USE mod_phys_lmdz_para
-    USE mod_grid_phy_lmdz, ONLY: nbp_lon
-    USE print_control_mod, ONLY: lunout,prt_level
+    USE lmdz_phys_para
+    USE lmdz_grid_phy, ONLY: nbp_lon
+    USE lmdz_print_control, ONLY: lunout,prt_level
     USE wxios
 
@@ -558,6 +558,6 @@
       END IF
 
-    ! ug On rÃ©cupÃ¨re le type Ã©crit de la structure:
-    !       Assez moche, Ã|  refaire si meilleure mÃ©thode...
+    ! ug On récupère le type écrit de la structure:
+    !       Assez moche, �|  refaire si meilleure méthode...
     IF (INDEX(var%cosp_typeecrit(iff), "once") > 0) THEN
        typeecrit = 'once'
@@ -603,10 +603,11 @@
  SUBROUTINE histwrite2d_cosp(var,field)
   USE dimphy
-  USE mod_phys_lmdz_para
+  USE lmdz_phys_para
   USE ioipsl
   use iophy
-  USE mod_grid_phy_lmdz, ONLY: nbp_lon
-  USE print_control_mod, ONLY: lunout,prt_level
+  USE lmdz_grid_phy, ONLY: nbp_lon
+  USE lmdz_print_control, ONLY: lunout,prt_level
   USE lmdz_xios, only: xios_send_field, using_xios
+  USE lmdz_abort_physic, ONLY: abort_physic
 
   IMPLICIT NONE
@@ -628,8 +629,8 @@
     IF (prt_level >= 9) WRITE(lunout,*)'Begin histrwrite2d ',var%name
 
-  ! On regarde si on est dans la phase de dÃ©finition ou d'Ã©criture:
+  ! On regarde si on est dans la phase de définition ou d'écriture:
   IF(.NOT.cosp_varsdefined) THEN
 !$OMP MASTER
-      !Si phase de dÃ©finition.... on dÃ©finit
+      !Si phase de définition.... on définit
       CALL conf_cospoutputs(var%name,var%cles)
       DO iff=1, 3
@@ -640,5 +641,5 @@
 !$OMP END MASTER
   ELSE
-    !Et sinon on.... Ã©crit
+    !Et sinon on.... écrit
     IF (SIZE(field)/=klon) &
   CALL abort_physic('iophy::histwrite2d_cosp','Field first DIMENSION not equal to klon',1) 
@@ -689,10 +690,11 @@
   SUBROUTINE histwrite3d_cosp(var, field, nverts, ncols)
   USE dimphy
-  USE mod_phys_lmdz_para
+  USE lmdz_phys_para
   USE ioipsl
   use iophy
-  USE mod_grid_phy_lmdz, ONLY: nbp_lon
-  USE print_control_mod, ONLY: lunout,prt_level
+  USE lmdz_grid_phy, ONLY: nbp_lon
+  USE lmdz_print_control, ONLY: lunout,prt_level
   USE lmdz_xios, only: xios_send_field, using_xios
+  USE lmdz_abort_physic, ONLY: abort_physic
 
   IMPLICIT NONE
@@ -725,7 +727,7 @@
                nom=var%name
       END IF
-  ! On regarde si on est dans la phase de dÃ©finition ou d'Ã©criture:
+  ! On regarde si on est dans la phase de définition ou d'écriture:
   IF(.NOT.cosp_varsdefined) THEN
-      !Si phase de dÃ©finition.... on dÃ©finit
+      !Si phase de définition.... on définit
 !$OMP MASTER
       CALL conf_cospoutputs(var%name,var%cles)
@@ -737,5 +739,5 @@
 !$OMP END MASTER
   ELSE
-    !Et sinon on.... Ã©crit
+    !Et sinon on.... écrit
     IF (SIZE(field,1)/=klon) &
    CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)                                  
@@ -785,10 +787,11 @@
   SUBROUTINE histwrite4d_cosp(var, field)
   USE dimphy
-  USE mod_phys_lmdz_para
+  USE lmdz_phys_para
   USE ioipsl
   use iophy
-  USE mod_grid_phy_lmdz, ONLY: nbp_lon
-  USE print_control_mod, ONLY: lunout,prt_level
+  USE lmdz_grid_phy, ONLY: nbp_lon
+  USE lmdz_print_control, ONLY: lunout,prt_level
   USE lmdz_xios, only: xios_send_field, using_xios
+  USE lmdz_abort_physic, ONLY: abort_physic
 
   IMPLICIT NONE
@@ -809,5 +812,5 @@
 
   IF(cosp_varsdefined) THEN
-    !Et sinon on.... Ã©crit
+    !Et sinon on.... écrit
     IF (SIZE(field,1)/=klon) &
    CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)            
@@ -835,5 +838,5 @@
     !   en utilisant les routines getin de IOIPSL  
     use ioipsl
-    USE print_control_mod, ONLY: lunout,prt_level
+    USE lmdz_print_control, ONLY: lunout,prt_level
 
     IMPLICIT NONE
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/cosp_read_otputkeys.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/cosp_read_otputkeys.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/cosp_read_otputkeys.F90	(revision 5133)
@@ -15,5 +15,5 @@
   USE MOD_COSP_CONSTANTS
   USE MOD_COSP_TYPES
-  USE mod_phys_lmdz_para
+  USE lmdz_phys_para
 
 CONTAINS
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/phys_cosp.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/phys_cosp.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/phys_cosp.F90	(revision 5133)
@@ -77,6 +77,6 @@
   USE MOD_COSP_TYPES
   USE MOD_COSP
-  USE mod_phys_lmdz_para
-  USE mod_grid_phy_lmdz
+  USE lmdz_phys_para
+  USE lmdz_grid_phy
   use ioipsl
   use iophy
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_config.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_config.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_config.F90	(revision 5133)
@@ -41,5 +41,5 @@
 MODULE MOD_COSP_CONFIG
     USE COSP_KINDS, ONLY: wp,dp
-    USE mod_phys_lmdz_para
+    USE lmdz_phys_para
     IMPLICIT NONE
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_output_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_output_mod.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_output_mod.F90	(revision 5133)
@@ -245,5 +245,5 @@
   USE phys_cal_mod
   USE time_phylmdz_mod, ONLY: day_ref, annee_ref, day_ini, start_time, itau_phy
-  USE print_control_mod, ONLY: lunout
+  USE lmdz_print_control, ONLY: lunout
     ! ug Pour les sorties XIOS
   USE wxios
@@ -272,5 +272,5 @@
 !!! Variables d'entree
 
-! ug Variables utilisées pour récupérer le calendrier pour xios
+! ug Variables utilis�es pour r�cup�rer le calendrier pour xios
   INTEGER :: x_an, x_mois, x_jour
   REAL :: x_heure
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_output_write_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_output_write_mod.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_output_write_mod.F90	(revision 5133)
@@ -35,5 +35,5 @@
     USE ioipsl
     USE time_phylmdz_mod, ONLY: itau_phy, start_time, day_step_phy
-    USE print_control_mod, ONLY: lunout,prt_level
+    USE lmdz_print_control, ONLY: lunout,prt_level
     USE wxios, only: wxios_closedef
     USE lmdz_xios, only: xios_update_calendar, xios_field_is_active, using_xios
@@ -458,7 +458,7 @@
     USE dimphy
     use iophy
-    USE mod_phys_lmdz_para
-    USE mod_grid_phy_lmdz, ONLY: nbp_lon
-    USE print_control_mod, ONLY: lunout,prt_level
+    USE lmdz_phys_para
+    USE lmdz_grid_phy, ONLY: nbp_lon
+    USE lmdz_print_control, ONLY: lunout,prt_level
     USE wxios
 
@@ -473,6 +473,6 @@
     CHARACTER(LEN=20) :: typeecrit
 
-    ! ug On rÃ©cupÃ¨re le type Ã©crit de la structure:
-    !       Assez moche, Ã|  refaire si meilleure mÃ©thode...
+    ! ug On récupère le type écrit de la structure:
+    !       Assez moche, �|  refaire si meilleure méthode...
     IF (INDEX(var%cosp_typeecrit(iff), "once") > 0) THEN
        typeecrit = 'once'
@@ -519,7 +519,7 @@
     USE dimphy
     use iophy
-    USE mod_phys_lmdz_para
-    USE mod_grid_phy_lmdz, ONLY: nbp_lon
-    USE print_control_mod, ONLY: lunout,prt_level
+    USE lmdz_phys_para
+    USE lmdz_grid_phy, ONLY: nbp_lon
+    USE lmdz_print_control, ONLY: lunout,prt_level
     USE wxios
 
@@ -575,6 +575,6 @@
       END IF
 
-    ! ug On rÃ©cupÃ¨re le type Ã©crit de la structure:
-    !       Assez moche, Ã|  refaire si meilleure mÃ©thode...
+    ! ug On récupère le type écrit de la structure:
+    !       Assez moche, �|  refaire si meilleure méthode...
     IF (INDEX(var%cosp_typeecrit(iff), "once") > 0) THEN
        typeecrit = 'once'
@@ -620,10 +620,11 @@
  SUBROUTINE histwrite2d_cosp(var,field)
   USE dimphy
-  USE mod_phys_lmdz_para
+  USE lmdz_phys_para
   USE ioipsl
   use iophy
-  USE mod_grid_phy_lmdz, ONLY: nbp_lon
-  USE print_control_mod, ONLY: lunout,prt_level
+  USE lmdz_grid_phy, ONLY: nbp_lon
+  USE lmdz_print_control, ONLY: lunout,prt_level
   USE lmdz_xios, only: xios_send_field, using_xios
+  USE lmdz_abort_physic, ONLY: abort_physic
 
   IMPLICIT NONE
@@ -645,8 +646,8 @@
     IF (prt_level >= 9) WRITE(lunout,*)'Begin histrwrite2d ',var%name
 
-  ! On regarde si on est dans la phase de dÃ©finition ou d'Ã©criture:
+  ! On regarde si on est dans la phase de définition ou d'écriture:
   IF(.NOT.cosp_varsdefined) THEN
 !$OMP MASTER
-      !Si phase de dÃ©finition.... on dÃ©finit
+      !Si phase de définition.... on définit
       CALL conf_cospoutputs(var%name,var%cles)
       DO iff=1, 3
@@ -657,5 +658,5 @@
 !$OMP END MASTER
   ELSE
-    !Et sinon on.... Ã©crit
+    !Et sinon on.... écrit
     IF (SIZE(field)/=klon) &
   CALL abort_physic('iophy::histwrite2d_cosp','Field first DIMENSION not equal to klon',1) 
@@ -706,10 +707,11 @@
   SUBROUTINE histwrite3d_cosp(var, field, nverts, ncols)
   USE dimphy
-  USE mod_phys_lmdz_para
+  USE lmdz_phys_para
   USE ioipsl
   use iophy
-  USE mod_grid_phy_lmdz, ONLY: nbp_lon
-  USE print_control_mod, ONLY: lunout,prt_level
+  USE lmdz_grid_phy, ONLY: nbp_lon
+  USE lmdz_print_control, ONLY: lunout,prt_level
   USE lmdz_xios, only: xios_send_field, using_xios
+  USE lmdz_abort_physic, ONLY: abort_physic
 
   IMPLICIT NONE
@@ -742,7 +744,7 @@
                nom=var%name
       END IF
-  ! On regarde si on est dans la phase de dÃ©finition ou d'Ã©criture:
+  ! On regarde si on est dans la phase de définition ou d'écriture:
   IF(.NOT.cosp_varsdefined) THEN
-      !Si phase de dÃ©finition.... on dÃ©finit
+      !Si phase de définition.... on définit
 !$OMP MASTER
       CALL conf_cospoutputs(var%name,var%cles)
@@ -754,5 +756,5 @@
 !$OMP END MASTER
   ELSE
-    !Et sinon on.... Ã©crit
+    !Et sinon on.... écrit
     IF (SIZE(field,1)/=klon) &
    CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)                                  
@@ -802,10 +804,11 @@
   SUBROUTINE histwrite4d_cosp(var, field)
   USE dimphy
-  USE mod_phys_lmdz_para
+  USE lmdz_phys_para
   USE ioipsl
   use iophy
-  USE mod_grid_phy_lmdz, ONLY: nbp_lon
-  USE print_control_mod, ONLY: lunout,prt_level
+  USE lmdz_grid_phy, ONLY: nbp_lon
+  USE lmdz_print_control, ONLY: lunout,prt_level
   USE lmdz_xios, only: xios_send_field, using_xios
+  USE lmdz_abort_physic, ONLY: abort_physic
 
   IMPLICIT NONE
@@ -826,5 +829,5 @@
 
   IF(cosp_varsdefined) THEN
-    !Et sinon on.... Ã©crit
+    !Et sinon on.... écrit
     IF (SIZE(field,1)/=klon) &
    CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)            
@@ -852,5 +855,5 @@
     !   en utilisant les routines getin de IOIPSL  
     use ioipsl
-    USE print_control_mod, ONLY: lunout,prt_level
+    USE lmdz_print_control, ONLY: lunout,prt_level
 
     IMPLICIT NONE
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_read_otputkeys.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_read_otputkeys.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_read_otputkeys.F90	(revision 5133)
@@ -16,5 +16,5 @@
 !  USE MOD_COSP_TYPES
   use MOD_COSP_INTERFACE_v1p4
-  USE mod_phys_lmdz_para
+  USE lmdz_phys_para
 
 CONTAINS
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/phys_cosp2.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/phys_cosp2.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/phys_cosp2.F90	(revision 5133)
@@ -77,6 +77,6 @@
 !  USE MOD_COSP_TYPES
 !  USE MOD_COSP
-  USE mod_phys_lmdz_para
-  USE mod_grid_phy_lmdz
+  USE lmdz_phys_para
+  USE lmdz_grid_phy
   use ioipsl
   use iophy
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_interface.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_interface.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_interface.F90	(revision 5133)
@@ -63,6 +63,6 @@
 
 !!! Modules specifiques a l'interface LMDZ-COSP
-  use mod_phys_lmdz_para
-  use mod_grid_phy_lmdz
+  use lmdz_phys_para
+  use lmdz_grid_phy
   use ioipsl
   use iophy
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_output_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_output_mod.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_output_mod.F90	(revision 5133)
@@ -325,5 +325,5 @@
   USE phys_cal_mod
   USE time_phylmdz_mod, ONLY: day_ref, annee_ref, day_ini, start_time, itau_phy
-  USE print_control_mod, ONLY: lunout
+  USE lmdz_print_control, ONLY: lunout
   ! ug Pour les sorties XIOS
   USE wxios
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_output_write_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_output_write_mod.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_output_write_mod.F90	(revision 5133)
@@ -35,5 +35,5 @@
     USE ioipsl
     USE time_phylmdz_mod, ONLY: itau_phy, start_time, day_step_phy
-    USE print_control_mod, ONLY: lunout,prt_level
+    USE lmdz_print_control, ONLY: lunout,prt_level
     USE lmdz_cosp_read_outputkeys, only: cosp_config
 !COSPv2
@@ -654,7 +654,7 @@
     USE dimphy
     use iophy
-    USE mod_phys_lmdz_para
-    USE mod_grid_phy_lmdz, ONLY: nbp_lon
-    USE print_control_mod, ONLY: lunout,prt_level
+    USE lmdz_phys_para
+    USE lmdz_grid_phy, ONLY: nbp_lon
+    USE lmdz_print_control, ONLY: lunout,prt_level
   USE wxios
 
@@ -707,7 +707,7 @@
     USE dimphy
     use iophy
-    USE mod_phys_lmdz_para
-    USE mod_grid_phy_lmdz, ONLY: nbp_lon
-    USE print_control_mod, ONLY: lunout,prt_level
+    USE lmdz_phys_para
+    USE lmdz_grid_phy, ONLY: nbp_lon
+    USE lmdz_print_control, ONLY: lunout,prt_level
 
   USE wxios
@@ -801,11 +801,12 @@
  SUBROUTINE histwrite2d_cosp(var,field)
   USE dimphy
-  USE mod_phys_lmdz_para
+  USE lmdz_phys_para
   USE ioipsl
   use iophy
-  USE mod_grid_phy_lmdz, ONLY: nbp_lon
-  USE print_control_mod, ONLY: lunout,prt_level
+  USE lmdz_grid_phy, ONLY: nbp_lon
+  USE lmdz_print_control, ONLY: lunout,prt_level
 
   USE lmdz_xios, only: xios_send_field
+  USE lmdz_abort_physic, ONLY: abort_physic
 
   IMPLICIT NONE
@@ -883,11 +884,12 @@
   SUBROUTINE histwrite3d_cosp(var, field, nverts, ncols)
   USE dimphy
-  USE mod_phys_lmdz_para
+  USE lmdz_phys_para
   USE ioipsl
   use iophy
-  USE mod_grid_phy_lmdz, ONLY: nbp_lon
-  USE print_control_mod, ONLY: lunout,prt_level
+  USE lmdz_grid_phy, ONLY: nbp_lon
+  USE lmdz_print_control, ONLY: lunout,prt_level
 
   USE lmdz_xios, only: xios_send_field
+  USE lmdz_abort_physic, ONLY: abort_physic
 
 
@@ -974,11 +976,12 @@
   SUBROUTINE histwrite4d_cosp(var, field)
   USE dimphy
-  USE mod_phys_lmdz_para
+  USE lmdz_phys_para
   USE ioipsl
   use iophy
-  USE mod_grid_phy_lmdz, ONLY: nbp_lon
-  USE print_control_mod, ONLY: lunout,prt_level
+  USE lmdz_grid_phy, ONLY: nbp_lon
+  USE lmdz_print_control, ONLY: lunout,prt_level
 
   USE lmdz_xios, only: xios_send_field
+  USE lmdz_abort_physic, ONLY: abort_physic
 
 
@@ -1024,5 +1027,5 @@
     !   en utilisant les routines getin de IOIPSL  
     use ioipsl
-    USE print_control_mod, ONLY: lunout,prt_level
+    USE lmdz_print_control, ONLY: lunout,prt_level
 
     IMPLICIT NONE
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_read_outputkeys.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_read_outputkeys.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_read_outputkeys.F90	(revision 5133)
@@ -17,5 +17,5 @@
 module lmdz_cosp_read_outputkeys
 
-  USE mod_phys_lmdz_para
+  USE lmdz_phys_para
 
   !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cpl_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cpl_mod.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cpl_mod.F90	(revision 5133)
@@ -23,5 +23,5 @@
 ! in the module are compiled and not the subroutines.
   USE oasis
-  USE lmdz_write_field_phy
+  USE lmdz_writefield_phy
   USE time_phylmdz_mod, ONLY: day_step_phy
   
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_1dutils.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_1dutils.f90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_1dutils.f90	(revision 5133)
@@ -709,5 +709,5 @@
     USE phys_state_var_mod
     USE iostart
-    USE lmdz_write_field_phy
+    USE lmdz_writefield_phy
     USE infotrac
     USE control_mod
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_scheme.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_scheme.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_scheme.F90	(revision 5133)
@@ -102,5 +102,5 @@
 USE radiation_save,           ONLY : save_inputs
 
-USE mod_phys_lmdz_para
+USE lmdz_phys_para
 
 IMPLICIT NONE
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_setup.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_setup.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_setup.F90	(revision 5133)
@@ -61,5 +61,5 @@
 !        &                       IIceModelFu, IIceModelBaran, &
 !        &                       IOverlapExponentialRandom
-    USE mod_phys_lmdz_para
+    USE lmdz_phys_para
       
     USE YOMHOOK,  ONLY : LHOOK, DR_HOOK
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/lmdz/calcul_cloud_overlap_decorr_len.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/lmdz/calcul_cloud_overlap_decorr_len.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/lmdz/calcul_cloud_overlap_decorr_len.F90	(revision 5133)
@@ -26,8 +26,8 @@
 USE YOMHOOK  , ONLY : LHOOK, DR_HOOK, JPHOOK
 USE YOMCST   , ONLY : RPI
-USE geometry_mod, ONLY: latitude_deg
+USE lmdz_geometry, ONLY: latitude_deg
 USE lmdz_cloud_optics_prop_ini , ONLY : prmhc, prlmc
 USE setup_config_from_lmdz,   ONLY : driver_config_type
-USE write_field_phy
+USE lmdz_writefield_phy
 ! -------------------------------------------------------------------
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/lmdz/radiation_scheme_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/lmdz/radiation_scheme_mod.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/lmdz/radiation_scheme_mod.F90	(revision 5133)
@@ -64,5 +64,5 @@
 USE radiation_save,           ONLY : save_inputs
 
-USE mod_phys_lmdz_para
+USE lmdz_phys_para
 
 IMPLICIT NONE
@@ -750,5 +750,5 @@
 USE radiation_save,           ONLY : save_inputs
 
-USE mod_phys_lmdz_para
+USE lmdz_phys_para
 
 IMPLICIT NONE
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/lmdz/radiation_setup.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/lmdz/radiation_setup.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/lmdz/radiation_setup.F90	(revision 5133)
@@ -61,5 +61,5 @@
 !        &                       IIceModelFu, IIceModelBaran, &
 !        &                       IOverlapExponentialRandom
-    USE mod_phys_lmdz_para
+    USE lmdz_phys_para
       
     USE YOMHOOK,  ONLY : LHOOK, DR_HOOK
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/lmdz/readaerosolstrato_ecrad.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/lmdz/readaerosolstrato_ecrad.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/lmdz/readaerosolstrato_ecrad.F90	(revision 5133)
@@ -9,8 +9,8 @@
 
     USE phys_cal_mod, ONLY : mth_cur
-    USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, grid2dTo1d_glo, grid_type, unstructured
-    USE mod_phys_lmdz_mpi_data
-    USE mod_phys_lmdz_omp_data
-    USE mod_phys_lmdz_para 
+    USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat, klon_glo, grid2dTo1d_glo, grid_type, unstructured
+    USE lmdz_phys_mpi_data
+    USE lmdz_phys_omp_data
+    USE lmdz_phys_para
     USE phys_state_var_mod
     USE phys_local_var_mod
@@ -21,4 +21,5 @@
     USE radiation_config, ONLY : config_type
     USE YOMCST
+    USE lmdz_abort_physic, ONLY: abort_physic
 #ifdef CPP_XIOS
     USE xios
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_old.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_old.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_old.F90	(revision 5133)
@@ -9,5 +9,5 @@
 
     USE dimphy
-    USE lmdz_write_field_phy
+    USE lmdz_writefield_phy
     USE lmdz_thermcell_dv2, ONLY: thermcell_dv2
     USE lmdz_thermcell_dq, ONLY: thermcell_dq
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/oasis.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/oasis.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/oasis.F90	(revision 5133)
@@ -11,5 +11,5 @@
   USE dimphy
   USE lmdz_phys_para
-  USE lmdz_write_field_phy
+  USE lmdz_writefield_phy
 
 #ifdef CPP_COUPLE
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/physiq_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/physiq_mod.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/physiq_mod.F90	(revision 5133)
@@ -74,5 +74,5 @@
     USE ice_sursat_mod, ONLY: flight_init, airplane
     USE lmdz_vampir
-    USE lmdz_write_field_phy
+    USE lmdz_writefield_phy
     USE lmdz_wxios, ONLY: g_ctx, wxios_set_context
     USE lmdz_lscp, ONLY: lscp
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/radlwsw_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/radlwsw_m.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/radlwsw_m.F90	(revision 5133)
@@ -50,5 +50,5 @@
     USE lmdz_assert, ONLY: assert
     USE infotrac_phy, ONLY: type_trac
-    USE lmdz_write_field_phy
+    USE lmdz_writefield_phy
 
 #ifdef REPROBUS
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/readaerosol_interp.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/readaerosol_interp.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/readaerosol_interp.F90	(revision 5133)
@@ -18,5 +18,5 @@
   USE readaerosol_mod
   USE aero_mod, ONLY: naero_spc, name_aero
-  USE lmdz_write_field_phy
+  USE lmdz_writefield_phy
   USE phys_cal_mod
   USE lmdz_pres2lev
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/regr_pr_time_av_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/regr_pr_time_av_m.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/regr_pr_time_av_m.F90	(revision 5133)
@@ -2,5 +2,5 @@
 MODULE regr_pr_time_av_m
 
-  USE lmdz_write_field_phy
+  USE lmdz_writefield_phy
   USE lmdz_phys_transfert_para, ONLY: bcast
   USE lmdz_phys_para, ONLY: mpi_rank, omp_rank
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/aeropt_5wv_rrtm.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/aeropt_5wv_rrtm.F90	(revision 5133)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/aeropt_5wv_rrtm.F90	(revision 5133)
@@ -0,0 +1,607 @@
+!
+! $Id: aeropt_5wv_rrtm.F90 3288 2018-03-19 20:58:31Z oboucher $
+!
+
+SUBROUTINE AEROPT_5WV_RRTM(  &
+   pdel, m_allaer,           &
+   RHcl, ai, flag_aerosol,   &
+   flag_bc_internal_mixture, & 
+   pplay, t_seri,            &
+   tausum, drytausum, tau )
+
+  USE DIMPHY
+  USE aero_mod
+  USE phys_local_var_mod, ONLY: od443aer,od550aer,dryod550aer,od865aer,ec550aer,od550lt1aer,abs550aer
+  USE phys_output_var_mod, ONLY: dryaod_diag
+  USE YOMCST, ONLY: RD,RG
+
+  !
+  !    Yves Balkanski le 12 avril 2006
+  !    Celine Deandreis
+  !    Anne Cozic  Avril 2009
+  !    a partir d'une sous-routine de Johannes Quaas pour les sulfates
+  !    Olivier Boucher mars 2014 pour adaptation RRTM
+  !    
+  !
+  ! Refractive indices for seasalt come from Shettle and Fenn (1979)
+  !
+  ! Refractive indices from water come from Hale and Querry (1973)
+  !
+  ! Refractive indices from Ammonium Sulfate Toon and Pollack (1976)
+  !
+  ! Refractive indices for Dust, internal mixture of minerals coated with 1.5% hematite 
+  ! by Volume (Balkanski et al., 2006)
+  !
+  ! Refractive indices for POM: Kinne (pers. Communication 
+  !
+  ! Refractive index for BC from Shettle and Fenn (1979)
+  !
+  ! Shettle, E. P., & Fenn, R. W. (1979), Models for the aerosols of the lower atmosphere and 
+  ! the effects of humidity variations on their optical properties, U.S. Air Force Geophysics 
+  ! Laboratory Rept. AFGL-TR-79-0214, Hanscomb Air Force Base, MA.
+  !
+  ! Hale, G. M. and M. R. Querry, Optical constants of water in the 200-nm to 200-m 
+  ! wavelength region, Appl. Opt., 12, 555-563, 1973.
+  !
+  ! Toon, O. B. and J. B. Pollack, The optical constants of several atmospheric aerosol species:
+  ! Ammonium sulfate, aluminum oxide, and sodium chloride, J. Geohys. Res., 81, 5733-5748,
+  ! 1976.
+  !
+  ! Balkanski, Y., M. Schulz, T. Claquin And O. Boucher, Reevaluation of mineral aerosol 
+  ! radiative forcings suggests a better agreement with satellite and AERONET data, Atmospheric 
+  ! Chemistry and Physics Discussions., 6, pp 8383-8419, 2006.
+  !
+  IMPLICIT NONE
+  !
+  ! Input arguments:
+  !
+  REAL, DIMENSION(klon,klev), INTENT(IN)   :: pdel
+  REAL, DIMENSION(klon,klev,naero_tot), INTENT(IN) :: m_allaer
+  REAL, DIMENSION(klon,klev), INTENT(IN)   :: RHcl     ! humidite relative ciel clair
+  INTEGER,INTENT(IN)                       :: flag_aerosol
+  LOGICAL,INTENT(IN)                       :: flag_bc_internal_mixture
+  REAL, DIMENSION(klon,klev), INTENT(IN)   :: pplay
+  REAL, DIMENSION(klon,klev), INTENT(IN)   :: t_seri
+  !
+  ! Output arguments:
+  !
+  REAL, DIMENSION(klon), INTENT(OUT)                      :: ai      ! POLDER aerosol index 
+  REAL, DIMENSION(klon,nwave,naero_tot), INTENT(OUT)      :: tausum
+  REAL, DIMENSION(klon,naero_tot), INTENT(OUT)            :: drytausum
+  REAL, DIMENSION(klon,klev,nwave,naero_tot), INTENT(OUT) :: tau
+  !
+  ! Local
+  !
+  INTEGER, PARAMETER :: las = nwave_sw
+  LOGICAL :: soluble
+  
+  INTEGER :: i, k, m, aerindex
+  INTEGER :: spsol, spinsol, la
+  INTEGER :: RH_num(klon,klev)
+  INTEGER, PARAMETER :: la443 = 1
+  INTEGER, PARAMETER :: la550 = 2
+  INTEGER, PARAMETER :: la670 = 3
+  INTEGER, PARAMETER :: la765 = 4
+  INTEGER, PARAMETER :: la865 = 5
+  INTEGER, PARAMETER :: nbre_RH=12
+  INTEGER, PARAMETER :: naero_soluble=9   !  1- BC soluble; 2- POM soluble; 3- SO4 coarse
+                                          !  4- SO4 acc; 5 seasalt super-C; 6 seasalt coarse; 7 seasalt acc.
+                                          !  8- NO3 coarse; 9- NO3 accumulation
+  INTEGER, PARAMETER :: naero_insoluble=4 !  1- Dust; 2- BC insoluble; 3- POM insoluble; 4- NO3 insoluble
+
+  REAL :: zrho
+
+  REAL, PARAMETER :: RH_tab(nbre_RH)=(/0.,10.,20.,30.,40.,50.,60.,70.,80.,85.,90.,95./)
+  REAL, PARAMETER :: RH_MAX=95.
+  REAL :: delta(klon,klev), rh(klon,klev)
+  REAL :: tau_ae5wv_int   ! Intermediate computation of epaisseur optique aerosol
+  REAL :: abs_ae5wv_int   ! Intermediate computation of epaisseur optique aerosol
+  REAL :: od670aer(klon)  ! epaisseur optique aerosol extinction 670 nm
+  REAL :: fac
+  INTEGER, ALLOCATABLE, DIMENSION(:)  :: aerosol_name
+  INTEGER :: nb_aer, itau
+  LOGICAL :: ok_itau
+  
+  REAL :: zdh(klon,klev)
+  
+  REAL :: alpha_aers_5wv(nbre_RH,las,naero_soluble)   ! Ext. coeff. ** m2/g 
+  REAL :: abs_aers_5wv(nbre_RH,las,naero_soluble)     ! Abs. coeff. ** m2/g 
+  REAL :: alpha_aeri_5wv(las,naero_insoluble)         ! Ext. coeff. ** m2/g 
+  REAL :: abs_aeri_5wv(las,naero_insoluble)           ! Abs. coeff. ** m2/g 
+
+  !
+  ! BC internal mixture
+  !
+  INTEGER, PARAMETER ::  nbclassbc = 6  ! Added by Rong Wang/OB for the 5 fractions
+                                        ! of BC in the soluble mode:
+                                        ! bc_content/0.001, 0.01, 0.02, 0.05, 0.1/
+  ! for Maxwell-Garnet internal mixture
+  ! Detailed theory can be found in R. Wang Estimation of global black carbon ! direct
+  ! radiative forcing and its uncertainty constrained by observations. J.
+  ! Geophys. Res. Atmos. Added by R. Wang and OB
+  REAL :: alpha_MG_5wv(nbre_RH,las,nbclassbc)
+  REAL :: abs_MG_5wv(nbre_RH,las,nbclassbc)
+
+  !
+  ! Proprietes optiques
+  !
+  REAL :: fact_RH(nbre_RH), BC_massfra
+  INTEGER :: n, classbc
+
+! From here on we look at the optical parameters at 5 wavelengths: 443, 550, 670, 765 and 865 nm 
+
+ DATA alpha_aers_5wv/ &
+   ! BC Accumulation Soluble (AS)     
+  5.342, 5.342, 5.342, 5.342, 5.342, 5.829, 6.344, 7.470, 8.603, 8.736, 8.870,10.149, &
+  5.159, 5.159, 5.159, 5.159, 5.159, 5.608, 6.083, 7.121, 8.169, 8.293, 8.418, 9.612, &
+  4.849, 4.849, 4.849, 4.849, 4.849, 5.251, 5.674, 6.598, 7.533, 7.644, 7.756, 8.829, &
+  4.573, 4.573, 4.573, 4.573, 4.573, 4.936, 5.318, 6.152, 6.996, 7.096, 7.198, 8.171, &
+  4.274, 4.274, 4.274, 4.274, 4.274, 4.600, 4.942, 5.686, 6.441, 6.530, 6.621, 7.495, &
+   ! POM Accumulation Soluble (AS)    
+  5.300, 5.300, 5.300, 5.300, 5.300, 5.827, 6.392, 7.640, 8.898, 9.046, 9.195,10.606, &
+  4.569, 4.569, 4.569, 4.569, 4.569, 5.029, 5.528, 6.649, 7.802, 7.939, 8.077, 9.400, &
+  3.768, 3.768, 3.768, 3.768, 3.768, 4.152, 4.573, 5.533, 6.538, 6.658, 6.780, 7.955, &
+  3.210, 3.210, 3.210, 3.210, 3.210, 3.542, 3.909, 4.752, 5.644, 5.751, 5.860, 6.916, &
+  2.709, 2.709, 2.709, 2.709, 2.709, 2.994, 3.309, 4.041, 4.823, 4.917, 5.013, 5.949, &
+   ! Sulfate Coarse Soluble (CS)      
+  0.702, 0.702, 0.702, 0.702, 0.947, 1.025, 1.127, 1.266, 1.490, 1.675, 2.003, 2.857, &
+  0.725, 0.725, 0.725, 0.725, 0.977, 1.057, 1.163, 1.304, 1.529, 1.718, 2.051, 2.914, &
+  0.751, 0.751, 0.751, 0.751, 1.011, 1.093, 1.200, 1.345, 1.576, 1.768, 2.110, 2.973, &
+  0.769, 0.769, 0.769, 0.769, 1.034, 1.120, 1.227, 1.375, 1.613, 1.811, 2.153, 3.032, &
+  0.786, 0.786, 0.786, 0.786, 1.056, 1.144, 1.254, 1.406, 1.646, 1.850, 2.202, 3.088, &
+   !-- Sulfate Accumulation (BC content=0)
+  4.639, 4.639, 4.639, 4.639, 6.244, 6.878, 7.684, 8.805,10.638,12.174,14.880,21.828, &
+  3.966, 3.966, 3.966, 3.966, 5.359, 5.950, 6.707, 7.771, 9.540,11.046,13.742,20.884, &
+  3.234, 3.234, 3.234, 3.234, 4.393, 4.914, 5.587, 6.543, 8.160, 9.556,12.101,19.072, &
+  2.721, 2.721, 2.721, 2.721, 3.712, 4.175, 4.774, 5.634, 7.101, 8.383,10.747,17.381, &
+  2.262, 2.262, 2.262, 2.262, 3.102, 3.505, 4.030, 4.789, 6.097, 7.251, 9.403,15.581, &
+   ! Seasalt Super Coarse Soluble (SS)
+  0.194, 0.237, 0.254, 0.275, 0.299, 0.327, 0.366, 0.432, 0.544, 0.642, 0.824, 1.265, &
+  0.196, 0.240, 0.257, 0.278, 0.303, 0.331, 0.371, 0.437, 0.550, 0.648, 0.831, 1.274, &
+  0.198, 0.243, 0.260, 0.283, 0.306, 0.335, 0.376, 0.442, 0.557, 0.654, 0.839, 1.285, &
+  0.201, 0.246, 0.263, 0.286, 0.308, 0.338, 0.380, 0.445, 0.559, 0.660, 0.846, 1.289, &
+  0.203, 0.249, 0.266, 0.289, 0.312, 0.341, 0.384, 0.449, 0.564, 0.665, 0.852, 1.297, &
+   ! Seasalt Coarse Soluble (CS)      
+  0.576, 0.690, 0.738, 0.789, 0.855, 0.935, 1.046, 1.212, 1.512, 1.785, 2.258, 3.449, &
+  0.595, 0.713, 0.763, 0.814, 0.880, 0.963, 1.079, 1.248, 1.550, 1.826, 2.306, 3.507, &
+  0.617, 0.738, 0.789, 0.842, 0.911, 0.996, 1.113, 1.286, 1.592, 1.871, 2.369, 3.562, &
+  0.632, 0.755, 0.808, 0.862, 0.931, 1.018, 1.140, 1.316, 1.626, 1.909, 2.409, 3.622, &
+  0.645, 0.771, 0.825, 0.880, 0.951, 1.039, 1.164, 1.344, 1.661, 1.948, 2.455, 3.682, &
+   ! Seasalt Accumulation Soluble (AS)
+  3.684, 4.367, 4.711, 5.074, 5.438, 6.046, 6.793, 7.964,10.200,12.246,15.959,24.642, &
+  3.126, 3.717, 4.023, 4.349, 4.673, 5.229, 5.918, 7.018, 9.179,11.208,14.994,24.184, &
+  2.482, 2.973, 3.233, 3.511, 3.788, 4.272, 4.876, 5.858, 7.836, 9.739,13.393,22.658, &
+  2.086, 2.509, 2.735, 2.979, 3.220, 3.649, 4.186, 5.068, 6.874, 8.642,12.099,21.146, &
+  1.737, 2.097, 2.292, 2.503, 2.711, 3.086, 3.556, 4.337, 5.960, 7.571,10.779,19.427, &
+   ! Nitrate Coarse Soluble (CS)      
+  0.726, 0.726, 0.726, 0.796, 0.868, 0.947, 1.041, 1.246, 1.563, 1.872, 2.328, 2.447, &
+  0.753, 0.753, 0.753, 0.825, 0.900, 0.979, 1.075, 1.285, 1.610, 1.922, 2.385, 2.503, &
+  0.780, 0.780, 0.780, 0.854, 0.932, 1.013, 1.113, 1.326, 1.656, 1.979, 2.447, 2.579, &
+  0.797, 0.797, 0.797, 0.874, 0.953, 1.035, 1.138, 1.356, 1.697, 2.020, 2.495, 2.621, &
+  0.811, 0.811, 0.811, 0.890, 0.971, 1.055, 1.160, 1.384, 1.733, 2.062, 2.547, 2.675, &
+   ! Nitrate Accumulation Soluble (AS)
+  4.208, 4.208, 4.208, 4.693, 5.217, 5.778, 6.502, 8.108,10.722,13.327,17.185,18.210, &
+  3.386, 3.386, 3.386, 3.808, 4.268, 4.768, 5.420, 6.897, 9.377,11.923,15.803,16.852, &
+  2.650, 2.650, 2.650, 2.997, 3.380, 3.801, 4.357, 5.638, 7.850,10.189,13.858,14.870, &
+  2.174, 2.174, 2.174, 2.471, 2.802, 3.167, 3.652, 4.784, 6.774, 8.917,12.345,13.302, &
+  1.776, 1.776, 1.776, 2.028, 2.309, 2.622, 3.040, 4.026, 5.787, 7.717,10.858,11.745  /
+
+ DATA alpha_aeri_5wv/ &
+   ! Dust insoluble
+  0.788, 0.818, 0.842, 0.851, 0.853, &
+   ! BC insoluble 
+  5.342, 5.159, 4.849, 4.573, 4.274, &
+   ! POM insoluble
+  5.300, 4.569, 3.768, 3.210, 2.709, &
+   ! Nitrate insoluble
+  0.726, 0.753, 0.780, 0.797, 0.811 /
+!
+ DATA abs_aers_5wv/ &
+   ! absorption BC Accumulation Soluble (AS)
+  2.861, 2.861, 2.861, 2.861, 2.861, 3.089, 3.316, 3.767, 4.167, 4.211, 4.255, 4.647, &
+  2.806, 2.806, 2.806, 2.806, 2.806, 3.010, 3.209, 3.597, 3.935, 3.971, 4.008, 4.333, &
+  2.674, 2.674, 2.674, 2.674, 2.674, 2.847, 3.015, 3.335, 3.608, 3.638, 3.667, 3.924, &
+  2.566, 2.566, 2.566, 2.566, 2.566, 2.723, 2.872, 3.155, 3.393, 3.419, 3.444, 3.667, &
+  2.444, 2.444, 2.444, 2.444, 2.444, 2.585, 2.719, 2.968, 3.176, 3.199, 3.221, 3.413, &
+   ! absorption POM Accumulation Soluble (AS)
+  0.170, 0.170, 0.170, 0.170, 0.170, 0.167, 0.165, 0.162, 0.160, 0.160, 0.159, 0.158, &
+  0.145, 0.145, 0.145, 0.145, 0.145, 0.143, 0.142, 0.139, 0.138, 0.138, 0.138, 0.137, &
+  0.125, 0.125, 0.125, 0.125, 0.125, 0.123, 0.122, 0.120, 0.119, 0.119, 0.119, 0.119, &
+  0.131, 0.131, 0.131, 0.131, 0.131, 0.130, 0.129, 0.127, 0.127, 0.127, 0.127, 0.127, &
+  0.133, 0.133, 0.133, 0.133, 0.133, 0.132, 0.131, 0.131, 0.131, 0.131, 0.131, 0.131, &
+  ! absorption Sulfate Coarse Soluble (CS)
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+   !-- Absorption Sulfate Accumulation (BC content=0)
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+   ! absorption Seasalt Super Coarse Soluble (SS)
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+   ! absorption Seasalt Coarse Soluble (CS)
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+   ! absorption Seasalt Accumulation Soluble (AS)
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+   ! absorption Nitrate Coarse Soluble (CS)
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+   ! absorption Nitrate Accumulation Soluble (AS)
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
+  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000  /
+
+ DATA abs_aeri_5wv/ &
+   ! absorption Dust insoluble
+  0.081, 0.048, 0.032, 0.027, 0.019, &
+   ! absorption BC insoluble
+  2.861, 2.806, 2.674, 2.566, 2.444, &
+   ! absorption POM insoluble
+  0.170, 0.145, 0.125, 0.131, 0.133, &
+   ! absorption Nitrate insoluble
+  0.000, 0.000, 0.000, 0.000, 0.000 /
+
+! Added by R. Wang (July 31 2016)
+! properties for BC assuming Maxwell-Garnett rule and internal mixture
+
+   DATA alpha_MG_5wv/ &
+ !--BC content=0.001
+   4.293,  4.293,  4.293,  4.293,  4.320,  4.342,  4.271,  4.320,  4.476,  4.772,  5.310,  7.434, &
+   4.687,  4.687,  4.687,  4.687,  4.693,  4.602,  4.492,  4.413,  4.374,  4.462,  4.729,  6.274, &
+   4.802,  4.802,  4.802,  4.802,  4.776,  4.646,  4.516,  4.371,  4.231,  4.173,  4.217,  5.072, &
+   4.716,  4.716,  4.716,  4.716,  4.668,  4.548,  4.408,  4.249,  4.047,  3.951,  3.850,  4.259, &
+   4.520,  4.520,  4.520,  4.520,  4.461,  4.353,  4.230,  4.069,  3.850,  3.707,  3.524,  3.565, &
+ !--BC content=0.010
+   4.298,  4.298,  4.298,  4.298,  4.343,  4.333,  4.283,  4.325,  4.472,  4.751,  5.298,  7.402, &
+   4.692,  4.692,  4.692,  4.692,  4.695,  4.598,  4.499,  4.410,  4.383,  4.454,  4.739,  6.260, &
+   4.796,  4.796,  4.796,  4.796,  4.768,  4.644,  4.518,  4.376,  4.230,  4.172,  4.225,  5.048, &
+   4.708,  4.708,  4.708,  4.708,  4.659,  4.543,  4.411,  4.256,  4.053,  3.945,  3.855,  4.242, &
+   4.509,  4.509,  4.509,  4.509,  4.456,  4.351,  4.229,  4.072,  3.852,  3.707,  3.531,  3.560, &
+ !--BC content=0.020
+   4.301,  4.301,  4.301,  4.301,  4.353,  4.330,  4.291,  4.326,  4.478,  4.738,  5.288,  7.393, &
+   4.688,  4.688,  4.688,  4.688,  4.695,  4.596,  4.500,  4.412,  4.386,  4.454,  4.737,  6.248, &
+   4.787,  4.787,  4.787,  4.787,  4.761,  4.641,  4.516,  4.378,  4.231,  4.176,  4.226,  5.041, &
+   4.696,  4.696,  4.696,  4.696,  4.651,  4.538,  4.409,  4.256,  4.055,  3.948,  3.858,  4.240, &
+   4.497,  4.497,  4.497,  4.497,  4.448,  4.345,  4.225,  4.072,  3.854,  3.709,  3.535,  3.561, &
+ !--BC content=0.050
+   4.318,  4.318,  4.318,  4.318,  4.377,  4.337,  4.310,  4.334,  4.488,  4.724,  5.267,  7.342, &
+   4.678,  4.678,  4.678,  4.678,  4.693,  4.595,  4.506,  4.421,  4.396,  4.458,  4.734,  6.203, &
+   4.760,  4.760,  4.760,  4.760,  4.742,  4.631,  4.512,  4.381,  4.237,  4.185,  4.229,  5.015, &
+   4.662,  4.662,  4.662,  4.662,  4.629,  4.522,  4.401,  4.254,  4.062,  3.955,  3.867,  4.229, &
+   4.461,  4.461,  4.461,  4.461,  4.424,  4.328,  4.215,  4.068,  3.858,  3.718,  3.545,  3.562, &
+ !--BC content=0.100
+   4.348,  4.348,  4.348,  4.348,  4.404,  4.361,  4.337,  4.358,  4.503,  4.717,  5.240,  7.239, &
+   4.662,  4.662,  4.662,  4.662,  4.685,  4.596,  4.513,  4.437,  4.411,  4.468,  4.729,  6.123, &
+   4.716,  4.716,  4.716,  4.716,  4.713,  4.613,  4.505,  4.384,  4.249,  4.199,  4.235,  4.974, &
+   4.607,  4.607,  4.607,  4.607,  4.593,  4.497,  4.387,  4.252,  4.072,  3.969,  3.882,  4.212, &
+   4.403,  4.403,  4.403,  4.403,  4.385,  4.299,  4.196,  4.061,  3.865,  3.731,  3.564,  3.563, &
+ !--BC content=0.200
+   4.401,  4.401,  4.401,  4.401,  4.447,  4.409,  4.389,  4.405,  4.529,  4.715,  5.183,  7.007, &
+   4.631,  4.631,  4.631,  4.631,  4.666,  4.594,  4.526,  4.463,  4.439,  4.488,  4.714,  5.958, &
+   4.633,  4.633,  4.633,  4.633,  4.654,  4.575,  4.488,  4.387,  4.271,  4.224,  4.250,  4.894, &
+   4.505,  4.505,  4.505,  4.505,  4.520,  4.444,  4.356,  4.243,  4.089,  3.997,  3.912,  4.179, &
+   4.295,  4.295,  4.295,  4.295,  4.307,  4.239,  4.157,  4.045,  3.876,  3.757,  3.602,  3.569  /
+!
+   DATA abs_MG_5wv/ &
+ !--BC content=0.001
+  13.416, 13.416, 13.416, 13.416, 12.041, 11.928, 11.793, 11.680, 11.488, 11.367, 11.200, 10.968,&
+  10.085, 10.085, 10.085, 10.085,  9.116,  9.061,  8.977,  8.901,  8.778, 8.712,  8.617,  8.474, &
+   7.491,  7.491,  7.491,  7.491,  6.836,  6.808,  6.764,  6.719,  6.659, 6.613,  6.568,  6.508, &
+   6.269,  6.269,  6.269,  6.269,  5.774,  5.761,  5.734,  5.706,  5.665, 5.637,  5.615,  5.579, &
+   5.300,  5.300,  5.300,  5.300,  4.919,  4.913,  4.899,  4.882,  4.863, 4.847,  4.831,  4.825, &
+ !--BC content=0.010
+  12.829, 12.829, 12.829, 12.829, 11.692, 11.618, 11.523, 11.419, 11.278, 11.192, 11.055, 10.850,&
+   9.766,  9.766,  9.766,  9.766,  8.932,  8.890,  8.828,  8.762,  8.671, 8.617,  8.528,  8.411, &
+   7.316,  7.316,  7.316,  7.316,  6.739,  6.716,  6.684,  6.643,  6.597, 6.561,  6.517,  6.465, &
+   6.154,  6.154,  6.154,  6.154,  5.708,  5.696,  5.676,  5.651,  5.624, 5.602,  5.576,  5.543, &
+   5.216,  5.216,  5.216,  5.216,  4.874,  4.870,  4.860,  4.848,  4.835, 4.823,  4.810,  4.800, &
+ !--BC content=0.020
+  12.290, 12.290, 12.290, 12.290, 11.358, 11.315, 11.248, 11.175, 11.073, 11.008, 10.902, 10.743,&
+   9.455,  9.455,  9.455,  9.455,  8.743,  8.716,  8.671,  8.622,  8.556, 8.513,  8.442,  8.349, &
+   7.142,  7.142,  7.142,  7.142,  6.635,  6.621,  6.596,  6.567,  6.532, 6.503,  6.469,  6.428, &
+   6.033,  6.033,  6.033,  6.033,  5.634,  5.629,  5.615,  5.598,  5.578, 5.561,  5.541,  5.517, &
+   5.130,  5.130,  5.130,  5.130,  4.821,  4.821,  4.816,  4.809,  4.801, 4.794,  4.784,  4.781, &
+ !--BC content=0.050
+  10.989, 10.989, 10.989, 10.989, 10.504, 10.523, 10.528, 10.528, 10.522, 10.512, 10.485, 10.445,&
+   8.671,  8.671,  8.671,  8.671,  8.239,  8.249,  8.248,  8.242,  8.233, 8.221,  8.199,  8.176, &
+   6.688,  6.688,  6.688,  6.688,  6.346,  6.354,  6.353,  6.350,  6.346, 6.339,  6.328,  6.322, &
+   5.707,  5.707,  5.707,  5.707,  5.427,  5.437,  5.440,  5.441,  5.444, 5.442,  5.438,  5.444, &
+   4.894,  4.894,  4.894,  4.894,  4.671,  4.682,  4.688,  4.694,  4.702, 4.705,  4.709,  4.726, &
+ !--BC content=0.100
+   9.397,  9.397,  9.397,  9.397,  9.357,  9.443,  9.525,  9.615,  9.725, 9.788,  9.866,  9.991, &
+   7.654,  7.654,  7.654,  7.654,  7.527,  7.581,  7.629,  7.682,  7.746, 7.781,  7.825,  7.901, &
+   6.070,  6.070,  6.070,  6.070,  5.922,  5.956,  5.986,  6.018,  6.057, 6.079,  6.105,  6.156, &
+   5.252,  5.252,  5.252,  5.252,  5.117,  5.146,  5.171,  5.198,  5.231, 5.250,  5.274,  5.322, &
+   4.557,  4.557,  4.557,  4.557,  4.441,  4.466,  4.489,  4.513,  4.544, 4.562,  4.586,  4.634, &
+ !--BC content=0.200
+   7.300,  7.300,  7.300,  7.300,  7.649,  7.799,  7.960,  8.149,  8.397, 8.559,  8.779,  9.149, &
+   6.225,  6.225,  6.225,  6.225,  6.403,  6.504,  6.610,  6.733,  6.893, 6.996,  7.136,  7.372, &
+   5.145,  5.145,  5.145,  5.145,  5.216,  5.282,  5.350,  5.429,  5.530, 5.595,  5.682,  5.833, &
+   4.550,  4.550,  4.550,  4.550,  4.587,  4.640,  4.694,  4.756,  4.836, 4.887,  4.957,  5.079, &
+   4.023,  4.023,  4.023,  4.023,  4.041,  4.084,  4.128,  4.178,  4.244, 4.286,  4.344,  4.447  /
+  ! 
+  ! Initialisations
+  ai(:) = 0.
+  abs550aer(:)=0.0
+  drytausum(:,:) = 0.
+  tausum(:,:,:) = 0.
+  tau(:,:,:,:)=0.
+
+  DO k=1, klev
+    DO i=1, klon
+      zrho=pplay(i,k)/t_seri(i,k)/RD                  ! kg/m3
+      zdh(i,k)=pdel(i,k)/(RG*zrho)                    ! m
+    ENDDO
+  ENDDO
+
+  IF (flag_aerosol .EQ. 1) THEN 
+     nb_aer = 2
+     ALLOCATE (aerosol_name(nb_aer)) 
+     aerosol_name(1) = id_ASSO4M_phy
+     aerosol_name(2) = id_CSSO4M_phy
+  ELSEIF (flag_aerosol .EQ. 2) THEN
+     nb_aer = 2
+     ALLOCATE (aerosol_name(nb_aer)) 
+     aerosol_name(1) = id_ASBCM_phy
+     aerosol_name(2) = id_AIBCM_phy
+  ELSEIF (flag_aerosol .EQ. 3) THEN 
+     nb_aer = 2
+     ALLOCATE (aerosol_name(nb_aer)) 
+     aerosol_name(1) = id_ASPOMM_phy
+     aerosol_name(2) = id_AIPOMM_phy
+  ELSEIF (flag_aerosol .EQ. 4) THEN 
+     nb_aer = 3
+     ALLOCATE (aerosol_name(nb_aer)) 
+     aerosol_name(1) = id_CSSSM_phy
+     aerosol_name(2) = id_SSSSM_phy
+     aerosol_name(3) = id_ASSSM_phy
+  ELSEIF (flag_aerosol .EQ. 5) THEN 
+     nb_aer = 1
+     ALLOCATE (aerosol_name(nb_aer)) 
+     aerosol_name(1) = id_CIDUSTM_phy
+  ELSEIF (flag_aerosol .EQ. 6 .OR. flag_aerosol .EQ. 7 ) THEN 
+     nb_aer = 13
+     ALLOCATE (aerosol_name(nb_aer)) 
+     aerosol_name(1) = id_ASSO4M_phy      
+     aerosol_name(2) = id_ASBCM_phy
+     aerosol_name(3) = id_AIBCM_phy
+     aerosol_name(4) = id_ASPOMM_phy
+     aerosol_name(5) = id_AIPOMM_phy
+     aerosol_name(6) = id_CSSSM_phy
+     aerosol_name(7) = id_SSSSM_phy
+     aerosol_name(8) = id_ASSSM_phy
+     aerosol_name(9) = id_CIDUSTM_phy
+     aerosol_name(10)= id_CSSO4M_phy
+     aerosol_name(11)= id_CSNO3M_phy
+     aerosol_name(12)= id_ASNO3M_phy
+     aerosol_name(13)= id_CINO3M_phy
+  ENDIF
+
+  ! 
+  ! Loop over modes, use of precalculated nmd and corresponding sigma
+  !    loop over wavelengths
+  !    for each mass species in mode
+  !      interpolate from Sext to retrieve Sext_at_gridpoint_per_species
+  !      compute optical_thickness_at_gridpoint_per_species
+  !
+  ! Calculations that need to be done since we are not in the subroutines INCA
+  !      
+
+  DO n=1,nbre_RH-1
+    fact_RH(n)=1./(RH_tab(n+1)-RH_tab(n))
+  ENDDO
+   
+  DO k=1, klev
+    DO i=1, klon
+      rh(i,k)=MIN(RHcl(i,k)*100.,RH_MAX)
+      RH_num(i,k) = INT( rh(i,k)/10. + 1.)
+      IF (rh(i,k).GT.85.) RH_num(i,k)=10
+      IF (rh(i,k).GT.90.) RH_num(i,k)=11
+      delta(i,k)=(rh(i,k)-RH_tab(RH_num(i,k)))*fact_RH(RH_num(i,k))
+    ENDDO
+  ENDDO
+
+  DO m=1,nb_aer   ! tau is only computed for each mass    
+    fac=1.0
+    IF (aerosol_name(m).EQ.id_ASBCM_phy) THEN
+        soluble=.TRUE.
+        spsol=1
+    ELSEIF (aerosol_name(m).EQ.id_ASPOMM_phy) THEN 
+        soluble=.TRUE.
+        spsol=2 
+    ELSEIF (aerosol_name(m).EQ.id_CSSO4M_phy) THEN
+        soluble=.TRUE.
+        spsol=3
+        !fac=1.375    ! (NH4)2-SO4/SO4 132/96 mass conversion factor for AOD
+        fac=0.0      !--6 March 2017 - OB as Didier H said CSSO4 should not be used
+    ELSEIF (aerosol_name(m).EQ.id_ASSO4M_phy) THEN
+        soluble=.TRUE.
+        spsol=4
+        fac=1.375    ! (NH4)2-SO4/SO4 132/96 mass conversion factor for AOD
+    ELSEIF (aerosol_name(m).EQ.id_SSSSM_phy) THEN 
+        soluble=.TRUE.
+        spsol=5
+    ELSEIF (aerosol_name(m).EQ.id_CSSSM_phy) THEN 
+        soluble=.TRUE.
+        spsol=6
+    ELSEIF (aerosol_name(m).EQ.id_ASSSM_phy) THEN
+        soluble=.TRUE.
+        spsol=7
+    ELSEIF (aerosol_name(m).EQ.id_CSNO3M_phy) THEN
+        soluble=.TRUE.
+        spsol=8
+        fac=1.2903    ! NO3NH4/NO3 / mass conversion factor for AOD
+    ELSEIF (aerosol_name(m).EQ.id_ASNO3M_phy) THEN
+        soluble=.TRUE.
+        spsol=9
+        fac=1.2903    ! NO3NH4/NO3 / mass conversion factor for AOD
+    ELSEIF (aerosol_name(m).EQ.id_CIDUSTM_phy) THEN 
+        soluble=.FALSE.
+        spinsol=1
+    ELSEIF  (aerosol_name(m).EQ.id_AIBCM_phy) THEN 
+        soluble=.FALSE.
+        spinsol=2
+    ELSEIF (aerosol_name(m).EQ.id_AIPOMM_phy) THEN 
+        soluble=.FALSE.
+        spinsol=3
+    ELSEIF (aerosol_name(m).EQ.id_CINO3M_phy) THEN 
+        soluble=.FALSE.
+        spinsol=4
+        fac=1.2903    ! NO3NH4/NO3 / mass conversion factor for AOD
+    ELSE 
+        CYCLE
+    ENDIF
+
+    aerindex=aerosol_name(m)
+
+    DO la=1,las
+
+    !--only 443, 550, and 865 nm are used
+    !--to save time 670 and AI are not computed for CMIP6
+    !IF (la.NE.la443.AND.la.NE.la550.AND.la.NE.la670.AND.la.NE.la865) CYCLE
+    IF (la.NE.la443.AND.la.NE.la550.AND.la.NE.la865) CYCLE
+
+      IF (soluble) THEN            ! For soluble aerosol
+
+        !--treat special case of soluble BC internal mixture
+        IF (spsol.EQ.1 .AND. flag_bc_internal_mixture) THEN
+
+          DO k=1, klev
+            DO i=1, klon
+
+             BC_massfra = m_allaer(i,k,id_ASBCM_phy)/(m_allaer(i,k,id_ASBCM_phy)+m_allaer(i,k,id_ASSO4M_phy))
+
+             IF (BC_massfra.GE.0.20) THEN
+               classbc = 6
+             ELSEIF (BC_massfra.GE.0.10) THEN
+               classbc = 5
+             ELSEIF  (BC_massfra.GE.0.05) THEN
+               classbc = 4
+             ELSEIF  (BC_massfra.GE.0.02) THEN
+               classbc = 3
+             ELSEIF  (BC_massfra.GE.0.01) THEN
+               classbc = 2
+             ELSE
+               classbc = 1
+             ENDIF
+
+             tau_ae5wv_int = alpha_MG_5wv(RH_num(i,k),la,classbc)+DELTA(i,k)* &
+                            (alpha_MG_5wv(RH_num(i,k)+1,la,classbc) - & 
+                             alpha_MG_5wv(RH_num(i,k),la,classbc))
+             tau(i,k,la,aerindex) = m_allaer(i,k,aerindex)/1.e6*zdh(i,k)*tau_ae5wv_int*fac
+             tausum(i,la,aerindex)=tausum(i,la,aerindex)+tau(i,k,la,aerindex)
+
+             IF (la.EQ.la550.AND.dryaod_diag) THEN 
+                tau_ae5wv_int = alpha_MG_5wv(1,la,classbc)
+                drytausum(i,aerindex)=drytausum(i,aerindex)+m_allaer(i,k,aerindex)/1.e6*zdh(i,k)*tau_ae5wv_int*fac
+             ENDIF
+
+             IF (la.EQ.la550) THEN 
+                abs_ae5wv_int = abs_MG_5wv(RH_num(i,k),la,classbc)+DELTA(i,k)* &
+                               (abs_MG_5wv(RH_num(i,k)+1,la,classbc) - & 
+                                abs_MG_5wv(RH_num(i,k),la,classbc))
+                abs550aer(i)=abs550aer(i)+m_allaer(i,k,aerindex)/1.e6*zdh(i,k)*abs_ae5wv_int*fac
+             ENDIF 
+
+            ENDDO
+          ENDDO
+
+        !--other cases of soluble aerosols
+        ELSE
+
+          DO k=1, klev
+            DO i=1, klon
+              tau_ae5wv_int = alpha_aers_5wv(RH_num(i,k),la,spsol)+DELTA(i,k)* &
+                             (alpha_aers_5wv(RH_num(i,k)+1,la,spsol) - & 
+                              alpha_aers_5wv(RH_num(i,k),la,spsol))
+              tau(i,k,la,aerindex) = m_allaer(i,k,aerindex)/1.e6*zdh(i,k)*tau_ae5wv_int*fac
+              tausum(i,la,aerindex)=tausum(i,la,aerindex)+tau(i,k,la,aerindex)
+
+              IF (la.EQ.la550.AND.dryaod_diag) THEN 
+                 tau_ae5wv_int = alpha_aers_5wv(1,la,spsol)
+                 drytausum(i,aerindex)=drytausum(i,aerindex)+m_allaer(i,k,aerindex)/1.e6*zdh(i,k)*tau_ae5wv_int*fac
+              ENDIF
+
+              IF (la.EQ.la550) THEN 
+                 abs_ae5wv_int = abs_aers_5wv(RH_num(i,k),la,spsol)+DELTA(i,k)* &
+                                (abs_aers_5wv(RH_num(i,k)+1,la,spsol) - & 
+                                 abs_aers_5wv(RH_num(i,k),la,spsol))
+                 abs550aer(i)=abs550aer(i)+m_allaer(i,k,aerindex)/1.e6*zdh(i,k)*abs_ae5wv_int*fac
+              ENDIF 
+
+            ENDDO
+          ENDDO
+
+        ENDIF
+ 
+      ! cases of insoluble aerosol
+      ELSE                         
+
+        DO k=1, klev
+          DO i=1, klon
+
+            tau_ae5wv_int = alpha_aeri_5wv(la,spinsol)
+            tau(i,k,la,aerindex) = m_allaer(i,k,aerindex)/1.e6*zdh(i,k)*tau_ae5wv_int*fac
+            tausum(i,la,aerindex)= tausum(i,la,aerindex)+tau(i,k,la,aerindex)
+
+            IF (la.EQ.la550.AND.dryaod_diag) THEN 
+              drytausum(i,aerindex)= drytausum(i,aerindex)+tau(i,k,la,aerindex)
+            ENDIF
+
+            IF (la.EQ.la550) THEN 
+               abs_ae5wv_int = abs_aeri_5wv(la,spinsol)
+               abs550aer(i)=abs550aer(i)+m_allaer(i,k,aerindex)/1.e6*zdh(i,k)*abs_ae5wv_int*fac
+            ENDIF 
+
+          ENDDO
+        ENDDO
+
+      ENDIF
+
+    ENDDO   ! Boucle sur les longueurs d'onde
+  ENDDO     ! Boucle sur les masses de traceurs
+
+!--AOD calculations for diagnostics
+  od443aer(:)=SUM(tausum(:,la443,:),dim=2)
+  od550aer(:)=SUM(tausum(:,la550,:),dim=2)
+  !od670aer(:)=SUM(tausum(:,la670,:),dim=2)
+  od865aer(:)=SUM(tausum(:,la865,:),dim=2)
+
+!--dry AOD calculation for diagnostics la=la550
+  dryod550aer(:)=SUM(drytausum(:,:),dim=2)
+
+!--extinction coefficient for diagnostic
+  ec550aer(:,:)=SUM(tau(:,:,la550,:),dim=3)/zdh(:,:)
+
+!--aerosol index
+  ai(:)=0.0
+  !ai(:)=-LOG(MAX(od670aer(:),1.e-8)/MAX(od865aer(:),1.e-8))/LOG(670./865.)
+
+  od550lt1aer(:)=tausum(:,la550,id_ASSO4M_phy)+tausum(:,la550,id_ASBCM_phy) +tausum(:,la550,id_AIBCM_phy)+ &
+                 tausum(:,la550,id_ASPOMM_phy)+tausum(:,la550,id_AIPOMM_phy)+tausum(:,la550,id_ASSSM_phy)+ &
+                 0.03*tausum(:,la550,id_CSSSM_phy)+0.4*tausum(:,la550,id_CIDUSTM_phy)
+
+  DEALLOCATE(aerosol_name) 
+  
+END SUBROUTINE AEROPT_5WV_RRTM
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/aeropt_6bands_rrtm.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/aeropt_6bands_rrtm.F90	(revision 5133)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/aeropt_6bands_rrtm.F90	(revision 5133)
@@ -0,0 +1,858 @@
+!
+! $Id: aeropt_6bands_rrtm.F90 4165 2022-05-26 19:56:53Z oboucher $
+!
+SUBROUTINE AEROPT_6BANDS_RRTM ( &
+     pdel, m_allaer, RHcl, &
+     tau_allaer, piz_allaer, &
+     cg_allaer, m_allaer_pi, &
+     flag_aerosol, flag_bc_internal_mixture, zrho, ok_volcan )
+
+  USE dimphy
+  USE aero_mod
+  USE YOMCST, ONLY: RG
+  USE lmdz_abort_physic, ONLY: abort_physic
+
+  !    Yves Balkanski le 12 avril 2006
+  !    Celine Deandreis
+  !    Anne Cozic Avril 2009
+  !    a partir d'une sous-routine de Johannes Quaas pour les sulfates
+  !    Olivier Boucher f�vrier 2014 pour passage � RRTM
+  !    a partir des propri�t�s optiques fournies par Yves Balkanski
+  !
+  IMPLICIT NONE
+  ! 
+  INCLUDE "clesphys.h"
+  !
+  ! Input arguments:
+  !
+  REAL, DIMENSION(klon,klev),     INTENT(IN)  :: pdel
+  REAL, DIMENSION(klon,klev,naero_tot),   INTENT(IN)  :: m_allaer
+  REAL, DIMENSION(klon,klev,naero_tot),   INTENT(IN)  :: m_allaer_pi
+  REAL, DIMENSION(klon,klev),     INTENT(IN)  :: RHcl       ! humidite relative ciel clair
+  INTEGER,                        INTENT(IN)  :: flag_aerosol
+  LOGICAL,                        INTENT(IN)  :: flag_bc_internal_mixture
+  REAL, DIMENSION(klon,klev),     INTENT(IN)  :: zrho
+  LOGICAL,                        INTENT(IN)  :: ok_volcan ! volcanic diags
+  !
+  ! Output arguments:
+  ! 2= total aerosols 
+  ! 1= natural aerosols
+  !
+  REAL, DIMENSION(klon,klev,2,nbands_sw_rrtm), INTENT(OUT) :: tau_allaer ! epaisseur optique aerosol
+  REAL, DIMENSION(klon,klev,2,nbands_sw_rrtm), INTENT(OUT) :: piz_allaer ! single scattering albedo aerosol
+  REAL, DIMENSION(klon,klev,2,nbands_sw_rrtm), INTENT(OUT) :: cg_allaer  ! asymmetry parameter aerosol
+  !
+  ! Local
+  !
+  LOGICAL :: soluble
+  INTEGER :: i, k,n, inu, m
+  INTEGER :: spsol, spinsol
+  INTEGER :: RH_num(klon,klev)
+
+  INTEGER, PARAMETER :: nb_level=19 ! number of vertical levels in DATA
+
+  INTEGER, PARAMETER :: naero_soluble=9    ! 1- BC soluble; 2- POM soluble; 3- SO4. acc. 4- SO4 coarse
+                                           ! 5- seasalt super coarse  6- seasalt
+                                           ! coarse  7- seasalt acc.
+                                           ! 8- NO3 coarse 9- NO3 acc.
+  INTEGER, PARAMETER :: naero_insoluble=4  ! 1- Dust; 2- BC insoluble; 3- POM insoluble; 4- NO3 insoluble
+
+  INTEGER, PARAMETER :: nbre_RH=12
+  REAL,PARAMETER :: RH_tab(nbre_RH)=(/0.,10.,20.,30.,40.,50.,60.,70.,80.,85.,90.,95./)
+  REAL, PARAMETER :: RH_MAX=95.
+  REAL :: delta(klon,klev), rh(klon,klev)
+  REAL :: tau_ae2b_int   ! Intermediate computation of epaisseur optique aerosol
+  REAL :: piz_ae2b_int   ! Intermediate computation of Single scattering albedo
+  REAL :: cg_ae2b_int    ! Intermediate computation of Assymetry parameter
+  REAL :: Fact_RH(nbre_RH)
+  REAL :: fac
+  REAL :: zdh(klon,klev) 
+  INTEGER, ALLOCATABLE, DIMENSION(:) :: aerosol_name
+  INTEGER :: nb_aer
+
+  REAL, DIMENSION(klon,klev,naero_tot,nbands_sw_rrtm) :: tau_ae
+  REAL, DIMENSION(klon,klev,naero_tot,nbands_sw_rrtm) :: piz_ae
+  REAL, DIMENSION(klon,klev,naero_tot,nbands_sw_rrtm) :: cg_ae
+
+  REAL, DIMENSION(klon,klev,naero_tot,nbands_sw_rrtm) :: tau_ae_pi
+  REAL, DIMENSION(klon,klev,id_ASBCM_phy:id_ASBCM_phy,nbands_sw_rrtm) :: piz_ae_pi
+  REAL, DIMENSION(klon,klev,id_ASBCM_phy:id_ASBCM_phy,nbands_sw_rrtm) :: cg_ae_pi
+  !
+  ! Proprietes optiques
+  !
+  REAL:: alpha_aers_6bands(nbre_RH,nbands_sw_rrtm,naero_soluble)   !--unit m2/g
+  REAL:: alpha_aeri_6bands(nbands_sw_rrtm,naero_insoluble)         !--unit m2/g
+  REAL:: cg_aers_6bands(nbre_RH,nbands_sw_rrtm,naero_soluble)      !--unitless
+  REAL:: cg_aeri_6bands(nbands_sw_rrtm,naero_insoluble)            !--unitless
+  REAL:: piz_aers_6bands(nbre_RH,nbands_sw_rrtm,naero_soluble)     !--unitless
+  REAL:: piz_aeri_6bands(nbands_sw_rrtm,naero_insoluble)           !--unitless
+  ! 
+  ! BC internal mixture
+  !
+  INTEGER, PARAMETER ::  nbclassbc = 6  ! Added by Rong Wang/OB for the 5 fractions
+                                        ! of BC in the soluble mode:
+                                        ! bc_content/0.001, 0.01, 0.02, 0.05, 0.1, 0.2/
+  ! for Maxwell-Garnet internal mixture
+  ! Detailed theory can be found in R. Wang Estimation of global black carbon direct
+  ! radiative forcing and its uncertainty constrained by observations. J.
+  ! Geophys. Res. Atmos. Added by R. Wang and OB
+  REAL :: alpha_MG_6bands(nbre_RH,nbands_sw_rrtm,nbclassbc)
+  REAL :: cg_MG_6bands(nbre_RH,nbands_sw_rrtm,nbclassbc)
+  REAL :: piz_MG_6bands(nbre_RH,nbands_sw_rrtm,nbclassbc)
+  !
+  INTEGER :: aerindex, classbc, classbc_pi
+  REAL :: tmp_var, tmp_var_pi, BC_massfra, BC_massfra_pi
+  CHARACTER*20 :: modname
+  !
+  REAL, PARAMETER :: tau_min = 1.e-7
+
+!***************************************************************************
+!--the order of the soluble   species has to follow the spsol   index below
+!--the order of the insoluble species has to follow the spinsol index below
+
+  DATA alpha_aers_6bands/  & 
+   ! BC Accumulation Soluble (AS)     
+  5.276, 5.276, 5.276, 5.276, 5.276, 5.797, 6.353, 7.568, 8.779, 8.920, 9.062,10.403, &
+  5.371, 5.371, 5.371, 5.371, 5.371, 5.870, 6.401, 7.559, 8.720, 8.857, 8.994,10.298, &
+  5.126, 5.126, 5.126, 5.126, 5.126, 5.572, 6.043, 7.073, 8.113, 8.235, 8.359, 9.544, &
+  4.225, 4.225, 4.225, 4.225, 4.225, 4.549, 4.887, 5.624, 6.370, 6.459, 6.548, 7.412, &
+  2.667, 2.667, 2.667, 2.667, 2.667, 2.840, 3.015, 3.382, 3.745, 3.788, 3.832, 4.251, &
+  1.113, 1.113, 1.113, 1.113, 1.113, 1.210, 1.307, 1.506, 1.699, 1.721, 1.744, 1.961, &
+   ! POM Accumulation Soluble (AS)    
+  5.962, 5.962, 5.962, 5.962, 5.962, 6.544, 7.153, 8.460, 9.732, 9.877,10.026,11.398, &
+  5.609, 5.609, 5.609, 5.609, 5.609, 6.163, 6.752, 8.041, 9.324, 9.473, 9.624,11.044, &
+  4.527, 4.527, 4.527, 4.527, 4.527, 4.982, 5.476, 6.586, 7.726, 7.861, 7.998, 9.306, &
+  2.697, 2.697, 2.697, 2.697, 2.697, 2.980, 3.293, 4.017, 4.790, 4.884, 4.979, 5.902, &
+  0.918, 0.918, 0.918, 0.918, 0.918, 1.025, 1.146, 1.435, 1.754, 1.794, 1.834, 2.232, &
+  0.105, 0.105, 0.105, 0.105, 0.105, 0.154, 0.211, 0.344, 0.491, 0.509, 0.528, 0.710, &
+  ! Sulfate Coarse Soluble (CS)      
+  0.670, 0.670, 0.670, 0.670, 0.905, 0.981, 1.081, 1.217, 1.434, 1.615, 1.940, 2.773, &
+  0.689, 0.689, 0.689, 0.689, 0.930, 1.009, 1.110, 1.247, 1.469, 1.655, 1.980, 2.825, &
+  0.726, 0.726, 0.726, 0.726, 0.978, 1.060, 1.164, 1.306, 1.533, 1.723, 2.056, 2.915, &
+  0.785, 0.785, 0.785, 0.785, 1.056, 1.144, 1.254, 1.406, 1.650, 1.852, 2.203, 3.103, &
+  0.795, 0.795, 0.795, 0.795, 1.064, 1.160, 1.282, 1.449, 1.720, 1.945, 2.340, 3.348, &
+  0.502, 0.502, 0.502, 0.502, 0.656, 0.728, 0.820, 0.950, 1.170, 1.360, 1.706, 2.666, &
+   !-- Sulfate Accumulation (BC content=0)
+  5.246, 5.246, 5.246, 5.246, 7.041, 7.658, 8.437, 9.503,11.204,12.608,15.030,21.080, &
+  4.924, 4.924, 4.924, 4.924, 6.619, 7.258, 8.067, 9.186,10.998,12.507,15.142,21.822, &
+  3.925, 3.925, 3.925, 3.925, 5.304, 5.888, 6.635, 7.686, 9.433,10.921,13.587,20.659, &
+  2.248, 2.248, 2.248, 2.248, 3.079, 3.477, 3.993, 4.738, 6.022, 7.153, 9.261,15.301, &
+  0.720, 0.720, 0.720, 0.720, 1.014, 1.169, 1.374, 1.678, 2.225, 2.726, 3.703, 6.779, &
+  0.069, 0.069, 0.069, 0.069, 0.102, 0.121, 0.146, 0.185, 0.258, 0.328, 0.472, 0.974, &
+   ! Seasalt Super Coarse Soluble (SS)
+  0.189, 0.232, 0.249, 0.270, 0.293, 0.322, 0.361, 0.425, 0.536, 0.634, 0.813, 1.250, &
+  0.192, 0.235, 0.252, 0.274, 0.296, 0.325, 0.365, 0.429, 0.542, 0.639, 0.821, 1.259, &
+  0.196, 0.240, 0.257, 0.279, 0.302, 0.331, 0.371, 0.437, 0.550, 0.649, 0.832, 1.274, &
+  0.204, 0.249, 0.267, 0.289, 0.313, 0.342, 0.384, 0.450, 0.565, 0.666, 0.851, 1.300, &
+  0.222, 0.270, 0.289, 0.313, 0.338, 0.369, 0.413, 0.482, 0.602, 0.705, 0.896, 1.355, &
+  0.244, 0.293, 0.313, 0.338, 0.364, 0.397, 0.443, 0.517, 0.646, 0.757, 0.960, 1.443, &
+   ! Seasalt Coarse Soluble (CS)      
+  0.547, 0.657, 0.705, 0.754, 0.817, 0.896, 1.008, 1.169, 1.456, 1.724, 2.199, 3.358, &
+  0.566, 0.679, 0.727, 0.776, 0.840, 0.920, 1.032, 1.196, 1.492, 1.760, 2.238, 3.416, &
+  0.596, 0.714, 0.764, 0.816, 0.882, 0.965, 1.081, 1.250, 1.552, 1.828, 2.310, 3.509, &
+  0.644, 0.771, 0.825, 0.880, 0.951, 1.040, 1.164, 1.345, 1.666, 1.957, 2.462, 3.700, &
+  0.640, 0.772, 0.829, 0.887, 0.965, 1.061, 1.198, 1.398, 1.758, 2.085, 2.658, 4.031, &
+  0.452, 0.562, 0.609, 0.659, 0.728, 0.813, 0.938, 1.125, 1.471, 1.797, 2.384, 3.855, &
+   ! Seasalt Accumulation Soluble (AS)
+  4.270, 5.032, 5.395, 5.772, 6.158, 6.768, 7.510, 8.634,10.695,12.512,15.740,23.122, &
+  3.952, 4.673, 5.030, 5.403, 5.781, 6.399, 7.156, 8.328,10.533,12.524,16.091,24.329, &
+  3.090, 3.676, 3.979, 4.301, 4.622, 5.172, 5.853, 6.941, 9.077,11.083,14.830,23.951, &
+  1.710, 2.069, 2.262, 2.471, 2.678, 3.048, 3.513, 4.285, 5.882, 7.467,10.618,19.102, &
+  0.529, 0.663, 0.737, 0.819, 0.901, 1.050, 1.244, 1.575, 2.301, 3.067, 4.704, 9.712, &
+  0.073, 0.142, 0.177, 0.215, 0.259, 0.328, 0.422, 0.579, 0.913, 1.263, 2.011, 4.358, &
+   ! Nitrate Coarse Soluble (CS)      
+  0.688, 0.688, 0.688, 0.755, 0.826, 0.900, 0.994, 1.190, 1.501, 1.804, 2.251, 2.374, &
+  0.712, 0.712, 0.712, 0.781, 0.853, 0.929, 1.023, 1.225, 1.540, 1.846, 2.299, 2.421, &
+  0.754, 0.754, 0.754, 0.826, 0.902, 0.980, 1.077, 1.286, 1.612, 1.925, 2.388, 2.509, &
+  0.809, 0.809, 0.809, 0.887, 0.969, 1.053, 1.160, 1.384, 1.732, 2.069, 2.557, 2.685, &
+  0.786, 0.786, 0.786, 0.867, 0.952, 1.043, 1.157, 1.403, 1.793, 2.171, 2.725, 2.871, &
+  0.703, 0.703, 0.703, 0.767, 0.836, 0.909, 1.002, 1.210, 1.552, 1.901, 2.434, 2.579, &
+   ! Nitrate Accumulation Soluble (AS)
+  5.251, 5.251, 5.251, 5.779, 6.336, 6.920, 7.655, 9.230,11.678,14.026,17.391,18.279, &
+  4.643, 4.643, 4.643, 5.152, 5.696, 6.276, 7.016, 8.640,11.238,13.787,17.511,18.494, &
+  3.373, 3.373, 3.373, 3.790, 4.245, 4.739, 5.383, 6.842, 9.289,11.804,15.637,16.675, &
+  1.779, 1.779, 1.779, 2.029, 2.309, 2.619, 3.033, 4.008, 5.746, 7.645,10.730,11.601, &
+  0.549, 0.549, 0.549, 0.639, 0.742, 0.859, 1.019, 1.412, 2.157, 3.029, 4.552, 5.002, &
+  0.367, 0.367, 0.367, 0.416, 0.471, 0.532, 0.614, 0.808, 1.166, 1.575, 2.281, 2.489  /
+
+  DATA piz_aers_6bands/&
+   ! BC Accumulation Soluble (AS)     
+  0.480, 0.480, 0.480, 0.480, 0.480, 0.487, 0.495, 0.513, 0.530, 0.532, 0.534, 0.553, &
+  0.469, 0.469, 0.469, 0.469, 0.469, 0.474, 0.480, 0.497, 0.514, 0.517, 0.519, 0.538, &
+  0.456, 0.456, 0.456, 0.456, 0.456, 0.464, 0.473, 0.495, 0.519, 0.522, 0.524, 0.550, &
+  0.427, 0.427, 0.427, 0.427, 0.427, 0.437, 0.448, 0.476, 0.505, 0.509, 0.512, 0.543, &
+  0.349, 0.349, 0.349, 0.349, 0.349, 0.358, 0.369, 0.396, 0.425, 0.429, 0.432, 0.465, &
+  0.196, 0.196, 0.196, 0.196, 0.196, 0.198, 0.202, 0.213, 0.226, 0.227, 0.229, 0.243, &
+   ! POM Accumulation Soluble (AS)    
+  0.956, 0.956, 0.956, 0.956, 0.956, 0.961, 0.964, 0.970, 0.974, 0.975, 0.975, 0.978, &
+  0.965, 0.965, 0.965, 0.965, 0.965, 0.969, 0.972, 0.977, 0.980, 0.980, 0.981, 0.983, &
+  0.969, 0.969, 0.969, 0.969, 0.969, 0.972, 0.975, 0.979, 0.983, 0.983, 0.983, 0.986, &
+  0.953, 0.953, 0.953, 0.953, 0.953, 0.958, 0.962, 0.969, 0.974, 0.975, 0.975, 0.979, &
+  0.892, 0.892, 0.892, 0.892, 0.892, 0.902, 0.912, 0.928, 0.940, 0.942, 0.943, 0.952, &
+  0.826, 0.826, 0.826, 0.826, 0.826, 0.658, 0.568, 0.479, 0.444, 0.442, 0.439, 0.426, &
+   ! Sulfate Coarse Soluble (CS)      
+  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
+  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
+  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
+  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
+  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
+  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
+   !-- Sulfate Accumulation (BC content=0)
+  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
+  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
+  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
+  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
+  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
+  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
+   ! Seasalt Super Coarse Soluble (SS)
+  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
+  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
+  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
+  0.999, 0.999, 0.999, 0.999, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
+  0.983, 0.985, 0.986, 0.987, 0.987, 0.988, 0.988, 0.989, 0.989, 0.989, 0.989, 0.989, &
+  0.957, 0.792, 0.765, 0.740, 0.721, 0.704, 0.687, 0.670, 0.652, 0.643, 0.631, 0.617, &
+   ! Seasalt Coarse Soluble (CS)      
+  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.001, 1.000, &
+  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
+  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
+  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
+  0.994, 0.994, 0.995, 0.995, 0.995, 0.995, 0.996, 0.996, 0.996, 0.996, 0.996, 0.996, &
+  0.976, 0.867, 0.837, 0.814, 0.796, 0.774, 0.754, 0.735, 0.713, 0.702, 0.690, 0.675, &
+   ! Seasalt Accumulation Soluble (AS)
+  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
+  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
+  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
+  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
+  0.995, 0.996, 0.996, 0.996, 0.997, 0.997, 0.997, 0.998, 0.998, 0.998, 0.998, 0.999, &
+  0.919, 0.607, 0.553, 0.515, 0.480, 0.455, 0.434, 0.421, 0.421, 0.429, 0.449, 0.492, &
+   ! Nitrate Coarse Soluble (CS)      
+  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
+  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
+  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
+  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
+  0.999, 0.999, 0.999, 0.999, 0.999, 0.999, 0.998, 0.998, 0.998, 0.998, 0.998, 0.998, &
+  0.707, 0.707, 0.707, 0.705, 0.702, 0.699, 0.697, 0.692, 0.686, 0.683, 0.679, 0.678, &
+   ! Nitrate Accumulation Soluble (AS)
+  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
+  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
+  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
+  1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
+  0.999, 0.999, 0.999, 0.999, 0.999, 0.999, 0.999, 0.999, 0.999, 0.999, 0.999, 0.999, &
+  0.362, 0.362, 0.362, 0.362, 0.363, 0.365, 0.367, 0.375, 0.390, 0.406, 0.428, 0.434  /
+
+  DATA cg_aers_6bands/ &
+   ! BC Accumulation Soluble (AS)     
+  0.820, 0.820, 0.820, 0.820, 0.820, 0.831, 0.840, 0.852, 0.859, 0.860, 0.860, 0.864, &
+  0.760, 0.760, 0.760, 0.760, 0.760, 0.777, 0.791, 0.812, 0.826, 0.827, 0.828, 0.837, &
+  0.695, 0.695, 0.695, 0.695, 0.695, 0.716, 0.734, 0.762, 0.780, 0.782, 0.784, 0.797, &
+  0.603, 0.603, 0.603, 0.603, 0.603, 0.628, 0.649, 0.685, 0.710, 0.712, 0.715, 0.734, &
+  0.469, 0.469, 0.469, 0.469, 0.469, 0.494, 0.518, 0.559, 0.590, 0.593, 0.597, 0.622, &
+  0.276, 0.276, 0.276, 0.276, 0.276, 0.292, 0.308, 0.337, 0.361, 0.364, 0.367, 0.389, &
+   ! POM Accumulation Soluble (AS)    
+  0.687, 0.687, 0.687, 0.687, 0.687, 0.700, 0.711, 0.729, 0.740, 0.741, 0.742, 0.750, &
+  0.685, 0.685, 0.685, 0.685, 0.685, 0.699, 0.712, 0.731, 0.744, 0.745, 0.747, 0.756, &
+  0.673, 0.673, 0.673, 0.673, 0.673, 0.689, 0.702, 0.724, 0.739, 0.741, 0.742, 0.754, &
+  0.637, 0.637, 0.637, 0.637, 0.637, 0.653, 0.667, 0.691, 0.709, 0.711, 0.712, 0.726, &
+  0.553, 0.553, 0.553, 0.553, 0.553, 0.568, 0.582, 0.607, 0.628, 0.630, 0.632, 0.649, &
+  0.340, 0.340, 0.340, 0.340, 0.340, 0.350, 0.361, 0.382, 0.400, 0.402, 0.404, 0.422, &
+   ! Sulfate Coarse Soluble (CS)      
+  0.746, 0.746, 0.746, 0.746, 0.779, 0.785, 0.790, 0.796, 0.804, 0.810, 0.816, 0.830, &
+  0.730, 0.730, 0.730, 0.730, 0.764, 0.770, 0.775, 0.782, 0.791, 0.797, 0.806, 0.819, &
+  0.707, 0.707, 0.707, 0.707, 0.746, 0.752, 0.758, 0.765, 0.775, 0.781, 0.790, 0.805, &
+  0.691, 0.691, 0.691, 0.691, 0.736, 0.741, 0.747, 0.754, 0.763, 0.769, 0.778, 0.791, &
+  0.696, 0.696, 0.696, 0.696, 0.748, 0.753, 0.759, 0.767, 0.776, 0.781, 0.789, 0.800, &
+  0.711, 0.711, 0.711, 0.711, 0.766, 0.773, 0.782, 0.791, 0.803, 0.811, 0.822, 0.838, &
+   !-- Sulfate Accumulation (BC content=0)
+  0.674, 0.674, 0.674, 0.674, 0.724, 0.729, 0.735, 0.741, 0.749, 0.753, 0.760, 0.769, &
+  0.677, 0.677, 0.677, 0.677, 0.729, 0.734, 0.740, 0.747, 0.756, 0.761, 0.768, 0.777, &
+  0.671, 0.671, 0.671, 0.671, 0.723, 0.730, 0.737, 0.746, 0.757, 0.764, 0.773, 0.786, &
+  0.638, 0.638, 0.638, 0.638, 0.691, 0.700, 0.710, 0.721, 0.736, 0.746, 0.760, 0.781, &
+  0.553, 0.553, 0.553, 0.553, 0.604, 0.616, 0.629, 0.644, 0.665, 0.680, 0.700, 0.736, &
+  0.344, 0.344, 0.344, 0.344, 0.388, 0.401, 0.416, 0.435, 0.462, 0.482, 0.512, 0.571, &
+   ! Seasalt Super Coarse Soluble (SS)
+  0.795, 0.810, 0.814, 0.819, 0.824, 0.829, 0.832, 0.840, 0.846, 0.849, 0.854, 0.860, &
+  0.788, 0.804, 0.808, 0.813, 0.818, 0.823, 0.828, 0.834, 0.842, 0.847, 0.851, 0.858, &
+  0.775, 0.792, 0.797, 0.803, 0.808, 0.813, 0.820, 0.826, 0.835, 0.840, 0.846, 0.854, &
+  0.754, 0.773, 0.779, 0.785, 0.791, 0.796, 0.803, 0.811, 0.821, 0.827, 0.834, 0.844, &
+  0.735, 0.755, 0.761, 0.768, 0.774, 0.779, 0.786, 0.794, 0.804, 0.810, 0.817, 0.829, &
+  0.712, 0.782, 0.795, 0.808, 0.819, 0.829, 0.840, 0.852, 0.865, 0.873, 0.882, 0.895, &
+   ! Seasalt Coarse Soluble (CS)      
+  0.754, 0.770, 0.776, 0.781, 0.784, 0.791, 0.797, 0.805, 0.815, 0.822, 0.828, 0.840, &
+  0.736, 0.753, 0.759, 0.765, 0.771, 0.778, 0.785, 0.793, 0.804, 0.811, 0.820, 0.831, &
+  0.716, 0.735, 0.742, 0.748, 0.754, 0.762, 0.769, 0.778, 0.789, 0.796, 0.807, 0.819, &
+  0.704, 0.725, 0.733, 0.739, 0.745, 0.752, 0.759, 0.768, 0.778, 0.784, 0.792, 0.803, &
+  0.716, 0.737, 0.744, 0.751, 0.756, 0.763, 0.770, 0.777, 0.786, 0.790, 0.795, 0.800, &
+  0.688, 0.730, 0.741, 0.751, 0.761, 0.771, 0.782, 0.795, 0.810, 0.820, 0.833, 0.849, &
+   ! Seasalt Accumulation Soluble (AS)
+  0.686, 0.711, 0.719, 0.726, 0.733, 0.740, 0.748, 0.755, 0.763, 0.767, 0.770, 0.774, &
+  0.690, 0.716, 0.724, 0.731, 0.739, 0.747, 0.756, 0.764, 0.774, 0.778, 0.782, 0.784, &
+  0.683, 0.710, 0.719, 0.727, 0.735, 0.744, 0.754, 0.765, 0.777, 0.784, 0.791, 0.797, &
+  0.649, 0.676, 0.686, 0.695, 0.704, 0.714, 0.726, 0.739, 0.757, 0.768, 0.781, 0.797, &
+  0.559, 0.586, 0.596, 0.606, 0.616, 0.629, 0.643, 0.661, 0.686, 0.703, 0.726, 0.758, &
+  0.341, 0.358, 0.366, 0.375, 0.382, 0.395, 0.408, 0.428, 0.459, 0.484, 0.520, 0.581, &
+   ! Nitrate Coarse Soluble (CS)      
+  0.765, 0.765, 0.765, 0.773, 0.779, 0.785, 0.791, 0.803, 0.813, 0.819, 0.827, 0.828, &
+  0.754, 0.754, 0.754, 0.762, 0.769, 0.774, 0.781, 0.790, 0.802, 0.810, 0.817, 0.818, &
+  0.743, 0.743, 0.743, 0.751, 0.758, 0.763, 0.770, 0.779, 0.789, 0.797, 0.804, 0.806, &
+  0.737, 0.737, 0.737, 0.745, 0.752, 0.758, 0.764, 0.773, 0.781, 0.786, 0.792, 0.793, &
+  0.739, 0.739, 0.739, 0.749, 0.757, 0.763, 0.770, 0.779, 0.788, 0.793, 0.797, 0.798, &
+  0.651, 0.651, 0.651, 0.672, 0.690, 0.707, 0.724, 0.751, 0.779, 0.796, 0.813, 0.817, &
+   ! Nitrate Accumulation Soluble (AS)
+  0.713, 0.713, 0.713, 0.723, 0.732, 0.739, 0.746, 0.756, 0.765, 0.769, 0.772, 0.772, &
+  0.724, 0.724, 0.724, 0.734, 0.742, 0.750, 0.757, 0.767, 0.777, 0.782, 0.785, 0.785, &
+  0.719, 0.719, 0.719, 0.729, 0.738, 0.746, 0.754, 0.767, 0.780, 0.787, 0.793, 0.794, &
+  0.673, 0.673, 0.673, 0.685, 0.696, 0.706, 0.717, 0.734, 0.753, 0.766, 0.778, 0.781, &
+  0.565, 0.565, 0.565, 0.580, 0.593, 0.605, 0.619, 0.644, 0.673, 0.693, 0.716, 0.720, &
+  0.328, 0.328, 0.328, 0.338, 0.348, 0.359, 0.371, 0.396, 0.431, 0.459, 0.494, 0.502  /
+
+  DATA alpha_aeri_6bands/  & 
+   ! Dust insoluble
+  0.735, 0.765, 0.817, 0.846, 0.718, 0.414, &
+   ! BC insoluble 
+  5.276, 5.371, 5.126, 4.225, 2.667, 1.113, &
+   ! POM insoluble
+  5.962, 5.609, 4.527, 2.697, 0.918, 0.105, &
+   ! Nitrate insoluble
+  0.688, 0.712, 0.754, 0.809, 0.786, 0.703 /
+
+  DATA piz_aeri_6bands/ &
+   ! Dust insoluble
+  0.894, 0.902, 0.937, 0.980, 0.993, 0.967, &
+   ! BC insoluble
+  0.480, 0.469, 0.456, 0.427, 0.349, 0.196, &
+   ! POM insoluble
+  0.956, 0.965, 0.969, 0.953, 0.892, 0.826, &
+   ! Nitrate insoluble
+  1.000, 1.000, 1.000, 1.000, 0.999, 0.707 /
+
+  DATA cg_aeri_6bands/ &
+   ! Dust insoluble
+  0.756, 0.737, 0.713, 0.701, 0.696, 0.672, &
+   ! BC insoluble
+  0.820, 0.760, 0.695, 0.603, 0.469, 0.276, &
+   ! POM insoluble
+  0.687, 0.685, 0.673, 0.637, 0.553, 0.340, &
+   ! Nitrate insoluble
+  0.765, 0.754, 0.743, 0.737, 0.739, 0.651 /
+
+! Added by R. Wang (July 31 2016)
+! properties for BC assuming Maxwell-Garnett rule and internal mixture
+
+   DATA alpha_MG_6bands/ &
+ !--BC content=0.001
+   3.546,  3.546,  3.546,  3.546,  3.640,  3.891,  3.883,  4.354,  4.967,  5.424,  6.412,  9.049, &
+   3.995,  3.995,  3.995,  3.995,  4.073,  4.091,  4.111,  4.209,  4.502,  4.878,  5.591,  8.029, &
+   4.650,  4.650,  4.650,  4.650,  4.661,  4.561,  4.472,  4.386,  4.373,  4.451,  4.726,  6.248, &
+   4.445,  4.445,  4.445,  4.445,  4.393,  4.291,  4.171,  4.017,  3.812,  3.682,  3.514,  3.593, &
+   2.837,  2.837,  2.837,  2.837,  2.824,  2.798,  2.760,  2.696,  2.579,  2.471,  2.265,  1.735, &
+   1.087,  1.087,  1.087,  1.087,  1.095,  1.101,  1.107,  1.110,  1.109,  1.101,  1.074,  0.944, &
+ !--BC content=0.010
+   3.550,  3.550,  3.550,  3.550,  3.623,  3.852,  4.006,  4.342,  4.945,  5.381,  6.394,  8.972, &
+   3.995,  3.995,  3.995,  3.995,  4.082,  4.094,  4.133,  4.235,  4.517,  4.871,  5.601,  8.001, &
+   4.653,  4.653,  4.653,  4.653,  4.662,  4.564,  4.475,  4.393,  4.376,  4.447,  4.736,  6.221, &
+   4.434,  4.434,  4.434,  4.434,  4.386,  4.286,  4.170,  4.021,  3.815,  3.680,  3.524,  3.583, &
+   2.831,  2.831,  2.831,  2.831,  2.820,  2.795,  2.757,  2.695,  2.579,  2.472,  2.270,  1.734, &
+   1.086,  1.086,  1.086,  1.086,  1.095,  1.101,  1.106,  1.110,  1.108,  1.101,  1.075,  0.944, &
+ !--BC content=0.020
+   3.549,  3.549,  3.549,  3.549,  3.630,  3.842,  4.016,  4.335,  4.928,  5.383,  6.369,  8.937, &
+   4.004,  4.004,  4.004,  4.004,  4.096,  4.100,  4.145,  4.243,  4.529,  4.870,  5.595,  7.973, &
+   4.650,  4.650,  4.650,  4.650,  4.662,  4.564,  4.478,  4.397,  4.379,  4.449,  4.734,  6.207, &
+   4.422,  4.422,  4.422,  4.422,  4.378,  4.280,  4.167,  4.020,  3.817,  3.683,  3.527,  3.583, &
+   2.824,  2.824,  2.824,  2.824,  2.815,  2.791,  2.754,  2.693,  2.579,  2.472,  2.272,  1.740, &
+   1.085,  1.085,  1.085,  1.085,  1.094,  1.100,  1.105,  1.109,  1.108,  1.100,  1.075,  0.945, &
+ !--BC content=0.050
+   3.563,  3.563,  3.563,  3.563,  3.662,  3.834,  4.019,  4.318,  4.889,  5.360,  6.305,  8.842, &
+   4.039,  4.039,  4.039,  4.039,  4.130,  4.126,  4.166,  4.261,  4.544,  4.863,  5.573,  7.895, &
+   4.641,  4.641,  4.641,  4.641,  4.659,  4.565,  4.483,  4.407,  4.389,  4.455,  4.731,  6.161, &
+   4.388,  4.388,  4.388,  4.388,  4.356,  4.264,  4.157,  4.017,  3.821,  3.691,  3.537,  3.582, &
+   2.805,  2.805,  2.805,  2.805,  2.801,  2.779,  2.744,  2.687,  2.577,  2.474,  2.279,  1.757, &
+   1.081,  1.081,  1.081,  1.081,  1.091,  1.098,  1.103,  1.107,  1.106,  1.099,  1.074,  0.949, &
+ !--BC content=0.100
+   3.607,  3.607,  3.607,  3.607,  3.701,  3.843,  4.021,  4.302,  4.841,  5.306,  6.214,  8.689, &
+   4.098,  4.098,  4.098,  4.098,  4.175,  4.168,  4.201,  4.291,  4.554,  4.854,  5.529,  7.763, &
+   4.627,  4.627,  4.627,  4.627,  4.651,  4.567,  4.490,  4.421,  4.403,  4.464,  4.723,  6.082, &
+   4.333,  4.333,  4.333,  4.333,  4.319,  4.236,  4.139,  4.011,  3.828,  3.704,  3.554,  3.580, &
+   2.773,  2.773,  2.773,  2.773,  2.778,  2.758,  2.727,  2.675,  2.573,  2.476,  2.291,  1.786, &
+   1.076,  1.076,  1.076,  1.076,  1.087,  1.094,  1.099,  1.103,  1.103,  1.097,  1.073,  0.954, &
+ !--BC content=0.200
+   3.702,  3.702,  3.702,  3.702,  3.768,  3.878,  4.030,  4.278,  4.757,  5.190,  6.032,  8.370, &
+   4.204,  4.204,  4.204,  4.204,  4.255,  4.246,  4.270,  4.345,  4.571,  4.837,  5.440,  7.494, &
+   4.598,  4.598,  4.598,  4.598,  4.633,  4.565,  4.502,  4.445,  4.428,  4.481,  4.706,  5.923, &
+   4.230,  4.230,  4.230,  4.230,  4.244,  4.179,  4.101,  3.996,  3.838,  3.728,  3.588,  3.581, &
+   2.710,  2.710,  2.710,  2.710,  2.730,  2.716,  2.693,  2.651,  2.564,  2.480,  2.314,  1.846, &
+   1.064,  1.064,  1.064,  1.064,  1.078,  1.085,  1.091,  1.096,  1.097,  1.091,  1.072,  0.965  /
+   
+   DATA piz_MG_6bands/ &
+ !--BC content=0.001
+  -3.984, -3.984, -3.984, -3.984, -3.395, -3.075, -3.051, -2.567, -2.053, -1.807, -1.308, -0.592, &
+  -3.014, -3.014, -3.014, -3.014, -2.520, -2.473, -2.411, -2.294, -2.027, -1.771, -1.368, -0.613, &
+  -1.142, -1.142, -1.142, -1.142, -0.930, -0.961, -0.981, -1.001, -0.981, -0.934, -0.798, -0.337, &
+  -0.202, -0.202, -0.202, -0.202, -0.129, -0.154, -0.183, -0.224, -0.284, -0.326, -0.383, -0.347, &
+   0.133,  0.133,  0.133,  0.133,  0.158,  0.146,  0.131,  0.107,  0.061,  0.015, -0.081, -0.433, &
+   0.137,  0.137,  0.137,  0.137,  0.148,  0.149,  0.149,  0.147,  0.139,  0.128,  0.098, -0.048, &
+ !--BC content=0.010
+  -3.640, -3.640, -3.640, -3.640, -3.219, -2.942, -2.761, -2.445, -1.983, -1.731, -1.262, -0.576, &
+  -2.791, -2.791, -2.791, -2.791, -2.383, -2.352, -2.290, -2.180, -1.943, -1.707, -1.321, -0.595, &
+  -1.069, -1.069, -1.069, -1.069, -0.889, -0.920, -0.945, -0.966, -0.954, -0.910, -0.775, -0.333, &
+  -0.185, -0.185, -0.185, -0.185, -0.119, -0.144, -0.173, -0.213, -0.275, -0.318, -0.372, -0.346, &
+   0.138,  0.138,  0.138,  0.138,  0.160,  0.149,  0.134,  0.110,  0.063,  0.018, -0.076, -0.430, &
+   0.137,  0.137,  0.137,  0.137,  0.148,  0.149,  0.150,  0.148,  0.140,  0.129,  0.099, -0.046, &
+ !--BC content=0.020
+  -3.369, -3.369, -3.369, -3.369, -3.033, -2.799, -2.619, -2.339, -1.913, -1.657, -1.223, -0.558, &
+  -2.592, -2.592, -2.592, -2.592, -2.254, -2.239, -2.185, -2.091, -1.869, -1.652, -1.284, -0.580, &
+  -1.004, -1.004, -1.004, -1.004, -0.849, -0.882, -0.909, -0.932, -0.926, -0.885, -0.758, -0.326, &
+  -0.168, -0.168, -0.168, -0.168, -0.108, -0.133, -0.163, -0.203, -0.265, -0.309, -0.364, -0.341, &
+   0.142,  0.142,  0.142,  0.142,  0.163,  0.152,  0.137,  0.113,  0.066,  0.022, -0.072, -0.422, &
+   0.138,  0.138,  0.138,  0.138,  0.149,  0.150,  0.150,  0.148,  0.140,  0.129,  0.100, -0.044, &
+ !--BC content=0.050
+  -2.743, -2.743, -2.743, -2.743, -2.582, -2.438, -2.292, -2.078, -1.729, -1.495, -1.123, -0.512, &
+  -2.121, -2.121, -2.121, -2.121, -1.939, -1.951, -1.926, -1.865, -1.688, -1.511, -1.188, -0.541, &
+  -0.839, -0.839, -0.839, -0.839, -0.742, -0.780, -0.812, -0.842, -0.848, -0.818, -0.707, -0.307, &
+  -0.121, -0.121, -0.121, -0.121, -0.078, -0.103, -0.133, -0.174, -0.236, -0.281, -0.337, -0.325, &
+   0.154,  0.154,  0.154,  0.154,  0.171,  0.160,  0.145,  0.121,  0.075,  0.032, -0.060, -0.399, &
+   0.141,  0.141,  0.141,  0.141,  0.150,  0.151,  0.152,  0.150,  0.142,  0.131,  0.103, -0.038, &
+ !--BC content=0.100
+  -2.025, -2.025, -2.025, -2.025, -2.035, -1.965, -1.875, -1.731, -1.475, -1.285, -0.980, -0.447, &
+  -1.569, -1.569, -1.569, -1.569, -1.540, -1.572, -1.580, -1.557, -1.444, -1.312, -1.052, -0.485, &
+  -0.628, -0.628, -0.628, -0.628, -0.593, -0.634, -0.672, -0.710, -0.732, -0.716, -0.631, -0.279, &
+  -0.054, -0.054, -0.054, -0.054, -0.032, -0.058, -0.088, -0.129, -0.191, -0.236, -0.295, -0.299, &
+   0.173,  0.173,  0.173,  0.173,  0.184,  0.173,  0.158,  0.135,  0.090,  0.048, -0.039, -0.361, &
+   0.145,  0.145,  0.145,  0.145,  0.153,  0.154,  0.154,  0.152,  0.144,  0.134,  0.107, -0.027, &
+ !--BC content=0.200
+  -1.155, -1.155, -1.155, -1.155, -1.300, -1.295, -1.272, -1.213, -1.077, -0.957, -0.747, -0.336, &
+  -0.884, -0.884, -0.884, -0.884, -0.979, -1.028, -1.065, -1.086, -1.054, -0.986, -0.820, -0.388, &
+  -0.332, -0.332, -0.332, -0.332, -0.360, -0.402, -0.444, -0.490, -0.531, -0.536, -0.492, -0.225, &
+   0.050,  0.050,  0.050,  0.050,  0.048,  0.022, -0.007, -0.047, -0.107, -0.152, -0.213, -0.245, &
+   0.204,  0.204,  0.204,  0.204,  0.208,  0.197,  0.182,  0.161,  0.120,  0.081,  0.002, -0.285, &
+   0.153,  0.153,  0.153,  0.153,  0.159,  0.159,  0.159,  0.157,  0.150,  0.140,  0.115, -0.005  /
+   
+   DATA cg_MG_6bands/ &
+ !--BC content=0.001
+   0.290,  0.290,  0.290,  0.290,  0.378,  0.381,  0.377,  0.378,  0.373,  0.344,  0.317,  0.118, &
+   0.374,  0.374,  0.374,  0.374,  0.469,  0.474,  0.480,  0.480,  0.475,  0.462,  0.438,  0.242, &
+   0.375,  0.375,  0.375,  0.375,  0.491,  0.502,  0.517,  0.527,  0.534,  0.529,  0.508,  0.255, &
+   0.242,  0.242,  0.242,  0.242,  0.455,  0.516,  0.577,  0.631,  0.687,  0.715,  0.748,  0.772, &
+   0.559,  0.559,  0.559,  0.559,  0.487,  0.461,  0.410,  0.303, -0.181, -3.594,  1.814,  1.164, &
+   0.323,  0.323,  0.323,  0.323,  0.339,  0.339,  0.337,  0.328,  0.295,  0.243,  0.045,  2.778, &
+ !--BC content=0.010
+   0.300,  0.300,  0.300,  0.300,  0.385,  0.389,  0.390,  0.386,  0.377,  0.353,  0.319,  0.116, &
+   0.384,  0.384,  0.384,  0.384,  0.478,  0.482,  0.488,  0.488,  0.483,  0.471,  0.442,  0.246, &
+   0.380,  0.380,  0.380,  0.380,  0.496,  0.507,  0.520,  0.531,  0.538,  0.534,  0.512,  0.259, &
+   0.233,  0.233,  0.233,  0.233,  0.454,  0.520,  0.581,  0.636,  0.691,  0.719,  0.752,  0.778, &
+   0.553,  0.553,  0.553,  0.553,  0.487,  0.461,  0.414,  0.308, -0.144, -2.858,  1.889,  1.165, &
+   0.323,  0.323,  0.323,  0.323,  0.338,  0.339,  0.337,  0.328,  0.295,  0.244,  0.051,  2.847, &
+ !--BC content=0.020
+   0.305,  0.305,  0.305,  0.305,  0.391,  0.394,  0.395,  0.390,  0.380,  0.358,  0.321,  0.112, &
+   0.391,  0.391,  0.391,  0.391,  0.484,  0.488,  0.493,  0.493,  0.488,  0.476,  0.445,  0.246, &
+   0.384,  0.384,  0.384,  0.384,  0.499,  0.511,  0.524,  0.534,  0.541,  0.537,  0.514,  0.260, &
+   0.219,  0.219,  0.219,  0.219,  0.451,  0.523,  0.586,  0.642,  0.696,  0.724,  0.756,  0.783, &
+   0.547,  0.547,  0.547,  0.547,  0.487,  0.461,  0.416,  0.315, -0.108, -2.308,  1.954,  1.170, &
+   0.322,  0.322,  0.322,  0.322,  0.338,  0.339,  0.337,  0.328,  0.296,  0.245,  0.056,  2.949, &
+ !--BC content=0.050
+   0.312,  0.312,  0.312,  0.312,  0.400,  0.402,  0.403,  0.398,  0.385,  0.364,  0.321,  0.094, &
+   0.402,  0.402,  0.402,  0.402,  0.495,  0.498,  0.503,  0.503,  0.496,  0.484,  0.451,  0.242, &
+   0.388,  0.388,  0.388,  0.388,  0.506,  0.518,  0.530,  0.541,  0.548,  0.544,  0.521,  0.259, &
+   0.152,  0.152,  0.152,  0.152,  0.434,  0.527,  0.599,  0.658,  0.711,  0.738,  0.768,  0.794, &
+   0.534,  0.534,  0.534,  0.534,  0.486,  0.463,  0.423,  0.332, -0.018, -1.355,  2.203,  1.188, &
+   0.321,  0.321,  0.321,  0.321,  0.337,  0.338,  0.336,  0.328,  0.297,  0.249,  0.071,  3.311, &
+ !--BC content=0.100
+   0.309,  0.309,  0.309,  0.309,  0.404,  0.405,  0.406,  0.401,  0.385,  0.364,  0.316,  0.057, &
+   0.406,  0.406,  0.406,  0.406,  0.503,  0.507,  0.511,  0.512,  0.504,  0.491,  0.456,  0.232, &
+   0.382,  0.382,  0.382,  0.382,  0.510,  0.523,  0.537,  0.548,  0.555,  0.551,  0.528,  0.255, &
+  -0.178, -0.178, -0.178, -0.178,  0.312,  0.524,  0.626,  0.692,  0.741,  0.765,  0.791,  0.816, &
+   0.519,  0.519,  0.519,  0.519,  0.486,  0.466,  0.432,  0.357,  0.091, -0.650,  2.968,  1.221, &
+   0.319,  0.319,  0.319,  0.319,  0.336,  0.337,  0.335,  0.328,  0.300,  0.255,  0.094,  4.314, &
+ !--BC content=0.200
+   0.267,  0.267,  0.267,  0.267,  0.388,  0.391,  0.392,  0.387,  0.370,  0.345,  0.287, -0.053, &
+   0.381,  0.381,  0.381,  0.381,  0.499,  0.506,  0.512,  0.514,  0.507,  0.494,  0.455,  0.198, &
+   0.318,  0.318,  0.318,  0.318,  0.494,  0.515,  0.535,  0.551,  0.561,  0.559,  0.535,  0.237, &
+   1.151,  1.151,  1.151,  1.151,  0.703,  0.643,  1.248,  0.874,  0.846,  0.846,  0.853,  0.868, &
+   0.502,  0.502,  0.502,  0.502,  0.486,  0.472,  0.447,  0.393,  0.226, -0.108,-43.753,  1.313, &
+   0.315,  0.315,  0.315,  0.315,  0.332,  0.334,  0.333,  0.327,  0.304,  0.266,  0.135, 21.079  /
+
+!----BEGINNING OF CALCULATIONS
+
+  modname='aeropt_6bands_rrtm'
+
+  spsol = 0
+  spinsol = 0 
+
+  IF (NSW.NE.nbands_sw_rrtm) THEN
+    CALL abort_physic(modname,'Erreur NSW doit etre egal a 6 pour cette routine',1)
+  ENDIF
+
+  zdh(:,:)=pdel(:,:)/(RG*zrho(:,:))      ! m
+
+  IF (flag_aerosol .EQ. 1) THEN 
+     nb_aer = 2
+     ALLOCATE (aerosol_name(nb_aer)) 
+     aerosol_name(1) = id_ASSO4M_phy
+     aerosol_name(2) = id_CSSO4M_phy
+  ELSEIF (flag_aerosol .EQ. 2) THEN
+     nb_aer = 2
+     ALLOCATE (aerosol_name(nb_aer)) 
+     aerosol_name(1) = id_ASBCM_phy
+     aerosol_name(2) = id_AIBCM_phy
+  ELSEIF (flag_aerosol .EQ. 3) THEN 
+     nb_aer = 2
+     ALLOCATE (aerosol_name(nb_aer)) 
+     aerosol_name(1) = id_ASPOMM_phy
+     aerosol_name(2) = id_AIPOMM_phy
+  ELSEIF (flag_aerosol .EQ. 4) THEN 
+     nb_aer = 3
+     ALLOCATE (aerosol_name(nb_aer)) 
+     aerosol_name(1) = id_CSSSM_phy
+     aerosol_name(2) = id_SSSSM_phy
+     aerosol_name(3) = id_ASSSM_phy
+  ELSEIF (flag_aerosol .EQ. 5) THEN 
+     nb_aer = 1
+     ALLOCATE (aerosol_name(nb_aer)) 
+     aerosol_name(1) = id_CIDUSTM_phy
+  ELSEIF (flag_aerosol .EQ. 6 .OR. flag_aerosol .EQ. 7 ) THEN 
+     nb_aer = 13
+     ALLOCATE (aerosol_name(nb_aer)) 
+     aerosol_name(1) = id_ASSO4M_phy      
+     aerosol_name(2) = id_ASBCM_phy
+     aerosol_name(3) = id_AIBCM_phy
+     aerosol_name(4) = id_ASPOMM_phy
+     aerosol_name(5) = id_AIPOMM_phy
+     aerosol_name(6) = id_CSSSM_phy
+     aerosol_name(7) = id_SSSSM_phy
+     aerosol_name(8) = id_ASSSM_phy
+     aerosol_name(9) = id_CIDUSTM_phy
+     aerosol_name(10)= id_CSSO4M_phy
+     aerosol_name(11)= id_CSNO3M_phy
+     aerosol_name(12)= id_ASNO3M_phy
+     aerosol_name(13)= id_CINO3M_phy
+  ENDIF
+
+  !
+  ! loop over modes, use of precalculated nmd and corresponding sigma
+  !    loop over wavelengths
+  !    for each mass species in mode
+  !      interpolate from Sext to retrieve Sext_at_gridpoint_per_species
+  !      compute optical_thickness_at_gridpoint_per_species
+
+  DO n=1,nbre_RH-1
+    fact_RH(n)=1./(RH_tab(n+1)-RH_tab(n))
+  ENDDO
+   
+  DO k=1, klev
+    DO i=1, klon
+      rh(i,k)=MIN(RHcl(i,k)*100.,RH_MAX)
+      RH_num(i,k) = INT(rh(i,k)/10. + 1.)
+      IF (rh(i,k).GT.85.) RH_num(i,k)=10
+      IF (rh(i,k).GT.90.) RH_num(i,k)=11
+      delta(i,k)=(rh(i,k)-RH_tab(RH_num(i,k)))*fact_RH(RH_num(i,k))
+    ENDDO
+  ENDDO
+
+  tau_ae(:,:,:,:)=0.
+  piz_ae(:,:,:,:)=0.
+  cg_ae(:,:,:,:)=0.
+
+  tau_ae_pi(:,:,:,:)=0.
+  piz_ae_pi(:,:,:,:)=0.
+  cg_ae_pi(:,:,:,:)=0.
+    
+  DO m=1,nb_aer   ! tau is only computed for each mass
+     fac=1.0
+     IF (aerosol_name(m).EQ.id_ASBCM_phy) THEN
+        soluble=.TRUE.
+        spsol=1
+     ELSEIF (aerosol_name(m).EQ.id_ASPOMM_phy) THEN 
+        soluble=.TRUE.
+        spsol=2 
+     ELSEIF (aerosol_name(m).EQ.id_CSSO4M_phy) THEN 
+        soluble=.TRUE.
+        spsol=3
+        !fac=1.375    ! (NH4)2-SO4/SO4 132/96 mass conversion factor for AOD
+        fac=0.0      !--6 March 2017 - OB as Didier H said CSSO4 should not be used
+     ELSEIF  (aerosol_name(m).EQ.id_ASSO4M_phy) THEN
+        soluble=.TRUE.
+        spsol=4
+        fac=1.375    ! (NH4)2-SO4/SO4 132/96 mass conversion factor for AOD
+     ELSEIF (aerosol_name(m).EQ.id_SSSSM_phy) THEN 
+         soluble=.TRUE.
+         spsol=5
+     ELSEIF (aerosol_name(m).EQ.id_CSSSM_phy) THEN 
+         soluble=.TRUE.
+         spsol=6
+     ELSEIF (aerosol_name(m).EQ.id_ASSSM_phy) THEN
+         soluble=.TRUE.
+         spsol=7
+     ELSEIF (aerosol_name(m).EQ.id_CSNO3M_phy) THEN
+         soluble=.TRUE.
+         spsol=8
+         fac=1.2903    ! NO3NH4/NO3 / mass conversion factor for AOD
+     ELSEIF (aerosol_name(m).EQ.id_ASNO3M_phy) THEN
+         soluble=.TRUE.
+         spsol=9
+         fac=1.2903    ! NO3NH4/NO3 / mass conversion factor for AOD
+     ELSEIF (aerosol_name(m).EQ.id_CIDUSTM_phy) THEN 
+         soluble=.FALSE.
+         spinsol=1
+     ELSEIF  (aerosol_name(m).EQ.id_AIBCM_phy) THEN 
+         soluble=.FALSE.
+         spinsol=2
+     ELSEIF (aerosol_name(m).EQ.id_AIPOMM_phy) THEN 
+         soluble=.FALSE.
+         spinsol=3
+     ELSEIF (aerosol_name(m).EQ.id_CINO3M_phy) THEN
+         soluble=.FALSE.
+         spinsol=4
+         fac=1.2903    ! NO3NH4/NO3 / mass conversion factor for AOD
+     ELSE 
+         CYCLE
+     ENDIF
+
+    !--shortname for aerosol index
+    aerindex=aerosol_name(m)
+
+    IF (soluble) THEN
+
+       !--here we treat the special case of soluble BC internal mixture with Maxwell-Garnett rule
+       IF (spsol.EQ.1 .AND. flag_bc_internal_mixture) THEN
+
+         DO k=1, klev
+           DO i=1, klon
+
+             tmp_var=m_allaer(i,k,aerindex)/1.e6*zdh(i,k)*fac
+             tmp_var_pi=m_allaer_pi(i,k,aerindex)/1.e6*zdh(i,k)*fac
+
+             ! Calculate the dry BC/(BC+SUL) mass ratio for all (natural+anthropogenic) aerosols
+             BC_massfra = m_allaer(i,k,id_ASBCM_phy)/(m_allaer(i,k,id_ASBCM_phy)+m_allaer(i,k,id_ASSO4M_phy))
+
+             IF (BC_massfra.GE.0.20) THEN
+               classbc = 6
+             ELSEIF (BC_massfra.GE.0.10) THEN
+               classbc = 5
+             ELSEIF  (BC_massfra.GE.0.05) THEN
+               classbc = 4
+             ELSEIF  (BC_massfra.GE.0.02) THEN
+               classbc = 3
+             ELSEIF  (BC_massfra.GE.0.01) THEN
+               classbc = 2
+             ELSE
+               classbc = 1
+             ENDIF
+
+             ! Calculate the dry BC/(BC+SUL) mass ratio for natural aerosols
+             BC_massfra_pi = m_allaer_pi(i,k,id_ASBCM_phy)/(m_allaer_pi(i,k,id_ASBCM_phy)+m_allaer_pi(i,k,id_ASSO4M_phy))
+
+             IF (BC_massfra_pi.GE.0.20) THEN
+               classbc_pi = 6
+             ELSEIF (BC_massfra_pi.GE.0.10) THEN
+               classbc_pi = 5
+             ELSEIF  (BC_massfra_pi.GE.0.05) THEN
+               classbc_pi = 4
+             ELSEIF  (BC_massfra_pi.GE.0.02) THEN
+               classbc_pi = 3
+             ELSEIF  (BC_massfra_pi.GE.0.01) THEN
+               classbc_pi = 2
+             ELSE
+               classbc_pi = 1
+             ENDIF
+
+             DO inu=1, NSW
+
+               !--all aerosols
+               tau_ae2b_int= alpha_MG_6bands(RH_num(i,k),inu,classbc)+                 &
+                             delta(i,k)* (alpha_MG_6bands(RH_num(i,k)+1,inu,classbc) - & 
+                             alpha_MG_6bands(RH_num(i,k),inu,classbc))
+                   
+               piz_ae2b_int = piz_MG_6bands(RH_num(i,k),inu,classbc) +                 &
+                              delta(i,k)* (piz_MG_6bands(RH_num(i,k)+1,inu,classbc) -  &
+                              piz_MG_6bands(RH_num(i,k),inu,classbc))
+                   
+               cg_ae2b_int = cg_MG_6bands(RH_num(i,k),inu,classbc) +                   & 
+                             delta(i,k)* (cg_MG_6bands(RH_num(i,k)+1,inu,classbc) -    &
+                             cg_MG_6bands(RH_num(i,k),inu,classbc))
+
+               tau_ae(i,k,aerindex,inu)    = tmp_var*tau_ae2b_int
+               piz_ae(i,k,aerindex,inu)    = piz_ae2b_int
+               cg_ae(i,k,aerindex,inu)     = cg_ae2b_int
+
+               !--natural aerosols
+               tau_ae2b_int= alpha_MG_6bands(RH_num(i,k),inu,classbc_pi)+                 &
+                             delta(i,k)* (alpha_MG_6bands(RH_num(i,k)+1,inu,classbc_pi) - & 
+                             alpha_MG_6bands(RH_num(i,k),inu,classbc_pi))
+                   
+               piz_ae2b_int = piz_MG_6bands(RH_num(i,k),inu,classbc_pi) +                 &
+                              delta(i,k)* (piz_MG_6bands(RH_num(i,k)+1,inu,classbc_pi) -  &
+                              piz_MG_6bands(RH_num(i,k),inu,classbc_pi))
+                   
+               cg_ae2b_int = cg_MG_6bands(RH_num(i,k),inu,classbc_pi) +                   &
+                             delta(i,k)* (cg_MG_6bands(RH_num(i,k)+1,inu,classbc_pi) -    &
+                             cg_MG_6bands(RH_num(i,k),inu,classbc_pi))
+
+               tau_ae_pi(i,k,aerindex,inu) = tmp_var_pi* tau_ae2b_int
+               piz_ae_pi(i,k,aerindex,inu) = piz_ae2b_int
+               cg_ae_pi(i,k,aerindex,inu)  = cg_ae2b_int
+                        
+             ENDDO
+           ENDDO
+         ENDDO
+
+       !--else treat all other cases of soluble aerosols
+       ELSE
+
+         DO k=1, klev
+           DO i=1, klon
+             tmp_var=m_allaer(i,k,aerindex)/1.e6*zdh(i,k)*fac
+             tmp_var_pi=m_allaer_pi(i,k,aerindex)/1.e6*zdh(i,k)*fac
+
+             DO inu=1, NSW
+
+               tau_ae2b_int= alpha_aers_6bands(RH_num(i,k),inu,spsol)+ & 
+                             delta(i,k)* (alpha_aers_6bands(RH_num(i,k)+1,inu,spsol) - & 
+                             alpha_aers_6bands(RH_num(i,k),inu,spsol))
+                   
+               piz_ae2b_int = piz_aers_6bands(RH_num(i,k),inu,spsol) + & 
+                            delta(i,k)* (piz_aers_6bands(RH_num(i,k)+1,inu,spsol) - & 
+                              piz_aers_6bands(RH_num(i,k),inu,spsol))
+                   
+               cg_ae2b_int = cg_aers_6bands(RH_num(i,k),inu,spsol) + & 
+                             delta(i,k)* (cg_aers_6bands(RH_num(i,k)+1,inu,spsol) - & 
+                             cg_aers_6bands(RH_num(i,k),inu,spsol))
+
+               tau_ae(i,k,aerindex,inu)    = tmp_var*tau_ae2b_int
+               tau_ae_pi(i,k,aerindex,inu) = tmp_var_pi* tau_ae2b_int
+               piz_ae(i,k,aerindex,inu)    = piz_ae2b_int
+               cg_ae(i,k,aerindex,inu)     = cg_ae2b_int
+                        
+             ENDDO
+           ENDDO
+         ENDDO
+
+         !--external mixture case for soluble BC
+         IF (spsol.EQ.1) THEN
+           piz_ae_pi(:,:,aerindex,:) = piz_ae(:,:,aerindex,:)
+           cg_ae_pi(:,:,aerindex,:)  = cg_ae(:,:,aerindex,:)
+         ENDIF
+
+       ENDIF
+        
+     ELSE    ! For all aerosol insoluble components
+
+       DO k=1, klev
+         DO i=1, klon
+           tmp_var=m_allaer(i,k,aerindex)/1.e6*zdh(i,k)*fac
+           tmp_var_pi=m_allaer_pi(i,k,aerindex)/1.e6*zdh(i,k)*fac
+
+           DO inu=1, NSW
+             tau_ae2b_int = alpha_aeri_6bands(inu,spinsol)
+             piz_ae2b_int = piz_aeri_6bands(inu,spinsol)
+             cg_ae2b_int = cg_aeri_6bands(inu,spinsol) 
+
+             tau_ae(i,k,aerindex,inu) = tmp_var*tau_ae2b_int
+             tau_ae_pi(i,k,aerindex,inu) = tmp_var_pi*tau_ae2b_int
+             piz_ae(i,k,aerindex,inu) = piz_ae2b_int
+             cg_ae(i,k,aerindex,inu)= cg_ae2b_int
+           ENDDO
+         ENDDO
+       ENDDO
+
+     ENDIF ! soluble / insoluble
+
+  ENDDO  ! nb_aer  
+
+  DO inu=1, NSW 
+     DO k=1, klev
+       DO i=1, klon
+!--all (natural + anthropogenic) aerosol
+         tau_allaer(i,k,2,inu)=tau_ae(i,k,id_ASSO4M_phy,inu)+tau_ae(i,k,id_CSSO4M_phy,inu)+ &
+                               tau_ae(i,k,id_ASBCM_phy,inu)+tau_ae(i,k,id_AIBCM_phy,inu)+   &
+                               tau_ae(i,k,id_ASPOMM_phy,inu)+tau_ae(i,k,id_AIPOMM_phy,inu)+ &
+                               tau_ae(i,k,id_ASSSM_phy,inu)+tau_ae(i,k,id_CSSSM_phy,inu)+   &
+                               tau_ae(i,k,id_SSSSM_phy,inu)+ tau_ae(i,k,id_CIDUSTM_phy,inu)
+         tau_allaer(i,k,2,inu)=MAX(tau_allaer(i,k,2,inu),tau_min)
+
+         piz_allaer(i,k,2,inu)=(tau_ae(i,k,id_ASSO4M_phy,inu)*piz_ae(i,k,id_ASSO4M_phy,inu)+   &
+                                tau_ae(i,k,id_CSSO4M_phy,inu)*piz_ae(i,k,id_CSSO4M_phy,inu)+   &
+                                tau_ae(i,k,id_ASBCM_phy,inu)*piz_ae(i,k,id_ASBCM_phy,inu)+     &
+                                tau_ae(i,k,id_AIBCM_phy,inu)*piz_ae(i,k,id_AIBCM_phy,inu)+     &
+                                tau_ae(i,k,id_ASPOMM_phy,inu)*piz_ae(i,k,id_ASPOMM_phy,inu)+   &
+                                tau_ae(i,k,id_AIPOMM_phy,inu)*piz_ae(i,k,id_AIPOMM_phy,inu)+   &
+                                tau_ae(i,k,id_ASSSM_phy,inu)*piz_ae(i,k,id_ASSSM_phy,inu)+     &
+                                tau_ae(i,k,id_CSSSM_phy,inu)*piz_ae(i,k,id_CSSSM_phy,inu)+     &
+                                tau_ae(i,k,id_SSSSM_phy,inu)*piz_ae(i,k,id_SSSSM_phy,inu)+     &
+                                tau_ae(i,k,id_CIDUSTM_phy,inu)*piz_ae(i,k,id_CIDUSTM_phy,inu)) &
+                                /tau_allaer(i,k,2,inu)
+         piz_allaer(i,k,2,inu)=MIN(MAX(piz_allaer(i,k,2,inu),0.01),1.0)
+         IF (tau_allaer(i,k,2,inu).LE.tau_min) piz_allaer(i,k,2,inu)=1.0
+
+         cg_allaer(i,k,2,inu)=(tau_ae(i,k,id_ASSO4M_phy,inu)*piz_ae(i,k,id_ASSO4M_phy,inu)*cg_ae(i,k,id_ASSO4M_phy,inu)+ &
+                               tau_ae(i,k,id_CSSO4M_phy,inu)*piz_ae(i,k,id_CSSO4M_phy,inu)*cg_ae(i,k,id_CSSO4M_phy,inu)+ &
+                               tau_ae(i,k,id_ASBCM_phy,inu)*piz_ae(i,k,id_ASBCM_phy,inu)*cg_ae(i,k,id_ASBCM_phy,inu)+    &
+                               tau_ae(i,k,id_AIBCM_phy,inu)*piz_ae(i,k,id_AIBCM_phy,inu)*cg_ae(i,k,id_AIBCM_phy,inu)+    &
+                               tau_ae(i,k,id_ASPOMM_phy,inu)*piz_ae(i,k,id_ASPOMM_phy,inu)*cg_ae(i,k,id_ASPOMM_phy,inu)+ &
+                               tau_ae(i,k,id_AIPOMM_phy,inu)*piz_ae(i,k,id_AIPOMM_phy,inu)*cg_ae(i,k,id_AIPOMM_phy,inu)+ &
+                               tau_ae(i,k,id_ASSSM_phy,inu)*piz_ae(i,k,id_ASSSM_phy,inu)*cg_ae(i,k,id_ASSSM_phy,inu)+    &
+                               tau_ae(i,k,id_CSSSM_phy,inu)*piz_ae(i,k,id_CSSSM_phy,inu)*cg_ae(i,k,id_CSSSM_phy,inu)+    &
+                               tau_ae(i,k,id_SSSSM_phy,inu)*piz_ae(i,k,id_SSSSM_phy,inu)*cg_ae(i,k,id_SSSSM_phy,inu)+    &
+                               tau_ae(i,k,id_CIDUSTM_phy,inu)*piz_ae(i,k,id_CIDUSTM_phy,inu)*cg_ae(i,k,id_CIDUSTM_phy,inu))/ &
+                               (tau_allaer(i,k,2,inu)*piz_allaer(i,k,2,inu))
+         cg_allaer(i,k,2,inu)=MIN(MAX(cg_allaer(i,k,2,inu),0.0),1.0)
+
+         IF (.NOT. ok_volcan) THEN
+!
+!--this is the default case
+!--in this case, index 1 of tau_allaer contains natural aerosols only
+!--because the objective is to perform the double radiation call with and without anthropogenic aerosols 
+!
+           tau_allaer(i,k,1,inu)=tau_ae_pi(i,k,id_ASSO4M_phy,inu)+tau_ae_pi(i,k,id_CSSO4M_phy,inu)+ &
+                                 tau_ae_pi(i,k,id_ASBCM_phy,inu)+tau_ae_pi(i,k,id_AIBCM_phy,inu)+   &
+                                 tau_ae_pi(i,k,id_ASPOMM_phy,inu)+tau_ae_pi(i,k,id_AIPOMM_phy,inu)+ &
+                                 tau_ae_pi(i,k,id_ASSSM_phy,inu)+tau_ae_pi(i,k,id_CSSSM_phy,inu)+   &
+                                 tau_ae_pi(i,k,id_SSSSM_phy,inu)+ tau_ae_pi(i,k,id_CIDUSTM_phy,inu)
+           tau_allaer(i,k,1,inu)=MAX(tau_allaer(i,k,1,inu),tau_min)
+         
+           piz_allaer(i,k,1,inu)=(tau_ae_pi(i,k,id_ASSO4M_phy,inu)*piz_ae(i,k,id_ASSO4M_phy,inu)+   &
+                                  tau_ae_pi(i,k,id_CSSO4M_phy,inu)*piz_ae(i,k,id_CSSO4M_phy,inu)+   &
+                                  tau_ae_pi(i,k,id_ASBCM_phy,inu)*piz_ae_pi(i,k,id_ASBCM_phy,inu)+  &
+                                  tau_ae_pi(i,k,id_AIBCM_phy,inu)*piz_ae(i,k,id_AIBCM_phy,inu)+     &
+                                  tau_ae_pi(i,k,id_ASPOMM_phy,inu)*piz_ae(i,k,id_ASPOMM_phy,inu)+   &
+                                  tau_ae_pi(i,k,id_AIPOMM_phy,inu)*piz_ae(i,k,id_AIPOMM_phy,inu)+   &
+                                  tau_ae_pi(i,k,id_ASSSM_phy,inu)*piz_ae(i,k,id_ASSSM_phy,inu)+     &
+                                  tau_ae_pi(i,k,id_CSSSM_phy,inu)*piz_ae(i,k,id_CSSSM_phy,inu)+     &
+                                  tau_ae_pi(i,k,id_SSSSM_phy,inu)*piz_ae(i,k,id_SSSSM_phy,inu)+     &
+                                  tau_ae_pi(i,k,id_CIDUSTM_phy,inu)*piz_ae(i,k,id_CIDUSTM_phy,inu)) &
+                                  /tau_allaer(i,k,1,inu)
+           piz_allaer(i,k,1,inu)=MIN(MAX(piz_allaer(i,k,1,inu),0.01),1.0)
+           IF (tau_allaer(i,k,1,inu).LE.tau_min) piz_allaer(i,k,1,inu)=1.0
+         
+           cg_allaer(i,k,1,inu)=(tau_ae_pi(i,k,id_ASSO4M_phy,inu)*piz_ae(i,k,id_ASSO4M_phy,inu)*cg_ae(i,k,id_ASSO4M_phy,inu)+    &
+                                 tau_ae_pi(i,k,id_CSSO4M_phy,inu)*piz_ae(i,k,id_CSSO4M_phy,inu)*cg_ae(i,k,id_CSSO4M_phy,inu)+    &
+                                 tau_ae_pi(i,k,id_ASBCM_phy,inu)*piz_ae_pi(i,k,id_ASBCM_phy,inu)*cg_ae_pi(i,k,id_ASBCM_phy,inu)+ &
+                                 tau_ae_pi(i,k,id_AIBCM_phy,inu)*piz_ae(i,k,id_AIBCM_phy,inu)*cg_ae(i,k,id_AIBCM_phy,inu)+       &
+                                 tau_ae_pi(i,k,id_ASPOMM_phy,inu)*piz_ae(i,k,id_ASPOMM_phy,inu)*cg_ae(i,k,id_ASPOMM_phy,inu)+    &
+                                 tau_ae_pi(i,k,id_AIPOMM_phy,inu)*piz_ae(i,k,id_AIPOMM_phy,inu)*cg_ae(i,k,id_AIPOMM_phy,inu)+    &
+                                 tau_ae_pi(i,k,id_ASSSM_phy,inu)*piz_ae(i,k,id_ASSSM_phy,inu)*cg_ae(i,k,id_ASSSM_phy,inu)+       &
+                                 tau_ae_pi(i,k,id_CSSSM_phy,inu)*piz_ae(i,k,id_CSSSM_phy,inu)*cg_ae(i,k,id_CSSSM_phy,inu)+       &
+                                 tau_ae_pi(i,k,id_SSSSM_phy,inu)*piz_ae(i,k,id_SSSSM_phy,inu)*cg_ae(i,k,id_SSSSM_phy,inu)+       &
+                                 tau_ae_pi(i,k,id_CIDUSTM_phy,inu)*piz_ae(i,k,id_CIDUSTM_phy,inu)*cg_ae(i,k,id_CIDUSTM_phy,inu))/ &
+                                 (tau_allaer(i,k,1,inu)*piz_allaer(i,k,1,inu))
+           cg_allaer(i,k,1,inu)=MIN(MAX(cg_allaer(i,k,1,inu),0.0),1.0)
+!
+         ELSE
+!
+!--this is the case for VOLMIP
+!--in this case index 1 of tau_allaer contains all (natural+anthropogenic) aerosols (same as index 2 above)
+!--but stratospheric aerosols will not be added in rrtm/readaerosolstrato2 as
+!--the objective is to have the double radiation call with and without stratospheric aerosols
+!
+           tau_allaer(i,k,1,inu)=tau_allaer(i,k,2,inu)
+            
+           piz_allaer(i,k,1,inu)=piz_allaer(i,k,2,inu)
+            
+           cg_allaer(i,k,1,inu) =cg_allaer(i,k,2,inu)
+!
+         ENDIF
+        ENDDO
+      ENDDO
+    ENDDO
+   
+  DEALLOCATE(aerosol_name) 
+
+END SUBROUTINE AEROPT_6BANDS_RRTM
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/aeropt_lw_rrtm.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/aeropt_lw_rrtm.F90	(revision 5133)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/aeropt_lw_rrtm.F90	(revision 5133)
@@ -0,0 +1,79 @@
+!
+! aeropt_lw_rrtm.F90 2014-05-13 C. Kleinschmitt
+!                    2016-05-03 O. Boucher 
+!                    2016-12-17 O. Boucher
+!
+! This routine feeds aerosol LW properties to RRTM
+! we only consider absorption (not scattering)
+! we only consider dust for now
+
+SUBROUTINE AEROPT_LW_RRTM(ok_alw, pdel, zrho, flag_aerosol, m_allaer, m_allaer_pi)
+
+  USE dimphy
+  USE aero_mod
+  USE phys_state_var_mod, ONLY: tau_aero_lw_rrtm
+  USE YOERAD, ONLY: NLW
+  USE YOMCST, ONLY: RG
+  USE lmdz_abort_physic, ONLY: abort_physic
+
+  IMPLICIT NONE
+
+  INCLUDE "clesphys.h"
+  !
+  ! Input arguments:
+  !
+  LOGICAL, INTENT(IN)                              :: ok_alw
+  INTEGER, INTENT(IN)                              :: flag_aerosol
+  REAL, DIMENSION(klon,klev), INTENT(IN)           :: pdel, zrho
+  REAL, DIMENSION(klon,klev,naero_tot), INTENT(IN) :: m_allaer, m_allaer_pi
+  !
+  INTEGER inu, i, k
+  REAL :: zdh(klon,klev)
+  REAL :: tmp_var, tmp_var_pi
+  CHARACTER*20 modname
+  !
+  !--absorption coefficient for CIDUST
+  REAL:: alpha_abs_CIDUST_16bands(nbands_lw_rrtm)   !--unit m2/g 
+  DATA alpha_abs_CIDUST_16bands /                         &
+  0.001, 0.003, 0.005, 0.006, 0.012, 0.030, 0.148, 0.098, &
+  0.017, 0.053, 0.031, 0.008, 0.010, 0.011, 0.013, 0.015  /
+  !
+  modname='aeropt_lw_rrtm'
+  !
+  IF (NLW.NE.nbands_lw_rrtm) THEN
+    CALL abort_physic(modname,'Erreur NLW doit etre egal a 16 pour cette routine',1)
+  ENDIF
+  ! 
+  IF (ok_alw) THEN                                   !--aerosol LW effects
+   !
+   IF (flag_aerosol.EQ.5.OR.flag_aerosol.EQ.6.OR.flag_aerosol.EQ.7) THEN  !-Dust
+    !
+    zdh(:,:)=pdel(:,:)/(RG*zrho(:,:))      ! m
+    !
+    DO k=1, klev
+      DO i=1, klon
+         !
+         tmp_var   =m_allaer(i,k,id_CIDUSTM_phy)   /1.e6*zdh(i,k)  !--g/m2
+         tmp_var_pi=m_allaer_pi(i,k,id_CIDUSTM_phy)/1.e6*zdh(i,k)  !--g/m2
+         !
+         DO inu=1, NLW
+           !
+           !--total aerosol
+           tau_aero_lw_rrtm(i,k,2,inu) = MAX(1.e-15,tmp_var*alpha_abs_CIDUST_16bands(inu))
+           !--natural aerosol 
+!           tau_aero_lw_rrtm(:,:,1,inu) = MAX(1.e-15,tmp_var_pi*alpha_abs_CIDUST_16bands(inu))
+           tau_aero_lw_rrtm(i,k,1,inu) = 1.e-15  !--test
+           !
+         ENDDO
+      ENDDO
+      !
+    ENDDO
+    ! 
+   ENDIF
+   !
+  ELSE !--no aerosol LW effects
+    !
+    tau_aero_lw_rrtm = 1.e-15
+  ENDIF
+  !
+END SUBROUTINE AEROPT_LW_RRTM
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/dump2ds.F
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/dump2ds.F	(revision 5133)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/dump2ds.F	(revision 5133)
@@ -0,0 +1,113 @@
+      SUBROUTINE dump2ds(im,jm,z,nom_z)
+C Copyright (C) 2005 Centre National de la Recherche Scientifique
+c ==================================================================
+c Perform a scatter plot print of big matrices using regular
+c intervals between min and max matrix coefficient values.
+c ==================================================================
+c adapted from LMD3 by Alain Lahellec and retranscipted for LMDZ5
+c NAN et INF ajoute aux plots                           Pat fin 2006
+c ==================================================================
+c Comme dump2d sauf que le signe est préservé, la valeur zero
+c identifiee par un blanc.
+c detection des Infty (= ou -) et NaN (?)
+c ==================================================================
+      IMPLICIT NONE
+      INTEGER im,jm
+      REAL z(im,jm),az
+      CHARACTER*32 jform,jline*1000
+      CHARACTER*1 iform(32)
+      CHARACTER*16 F1000
+      logical zinf,znan,zsign
+      CHARACTER (len=*) :: nom_z
+      INTEGER*4 icheck(2)
+      EQUIVALENCE(az,icheck)
+      EQUIVALENCE(iform,jform)
+      DATA jform/'-@zyxwvutsrqpon NOPQRSTUVWXYZ*+?'/
+      INTEGER i,j,k,imin,imax,jmin,jmax,kzero,kchar(im)
+      REAL zmin,zmax,zllu,zllm
+      write(F1000,'(''(4x,'',I3,''(1H-))'')')im+3
+      DO 10001 i=1,200
+      jline(1+(i-1)*5:5*i)='.    '
+10001 CONTINUE
+10002 zmin=z(1,1)
+      imin=1
+      jmin=1
+      zmax=z(1,1)
+      imax=1
+      jmax=1
+      kzero=0
+      DO 10003 j=1,jm
+      DO 10005 i=1,im
+      IF(.NOT.( z(i,j).GT.zmax))GOTO 10007
+      zmax=z(i,j)
+      imax=i
+      jmax=j
+10007 IF(.NOT.( z(i,j).LT.zmin))GOTO 10009
+      zmin=z(i,j)
+      imin=i
+      jmin=j
+10009 IF(.NOT.( z(i,j).eq.0.))GOTO 10011
+      kzero=kzero+1
+10011 CONTINUE
+10005 CONTINUE
+10006 CONTINUE
+10003 CONTINUE
+10004 zsign=(sign(1.,zmin)*sign(1.,zmax).gt.0.)
+      WRITE(*,*)'>>> dump2ds: ',trim(nom_z)
+      PRINT*,'>>>  ',kzero,' zero values  <<<'
+      IF(.NOT.( ZMin.lt.0.))GOTO 10013
+      PRINT2000,' [MIN:',zmin,'(',imin,',',jmin,') (-@zyxwvutsrqpon NOPQ
+     *RSTUVWXYZ*+) ',zmax,'(',imax,',',jmax,'):MAX]'
+      GOTO 10014
+10013 PRINT2000,' [MIN:',zmin,'(',imin,',',jmin,') ( NOPQRSTUVWXYZ*+) ',
+     *zmax,'(',imax,',',jmax,'):MAX]'
+10014 CONTINUE
+2000  Format(a,1pg11.4,a1,i3,a1,i3,a,1pg11.4,a1,i3,a1,i3,a)
+      IF(.NOT.( zmax.GT.zmin))GOTO 10015
+      zllm=max(abs(zmax),abs(zmin))
+      zllu=min(abs(zmax),abs(zmin))
+      if(im.ge.100)WRITE(*,'(104x,900i1)')(mod(i/100,10),i=100,im)
+      WRITE(*,'(14x,1000i1)')(mod(i/10,10),i=10,im)
+      WRITE(*,'(5x,1009i1)')(mod(i,10),i=1,im)
+      write(*,F1000)
+      zinf=.false.
+      znan=.false.
+      DO 10017 j=1,jm
+      DO 10019 i=1,im
+      az=abs(z(i,j))
+      IF(.NOT.( az.eq.0.))GOTO 10021
+      kchar(i)=16
+      GOTO 10022
+10021 IF(.NOT.((az.ne.0.and.icheck(1).eq.0.and.icheck(2).eq.2146435072))
+     *)GOTO 10023
+      kchar(i)=31
+      zinf=.true.
+      GOTO 10022
+10023 IF(.NOT.((az.ne.0.and.icheck(1).eq.0.and.icheck(2).eq.2146959360))
+     *)GOTO 10024
+      kchar(i)=32
+      znan=.true.
+      GOTO 10022
+10024 IF(.NOT.( zsign))GOTO 10025
+      kchar(i)=NINT(13.*(az-zllu)/(zllm-zllu)+17)
+      GOTO 10026
+10025 kchar(i)=NINT(13.*az/zllm+17)
+10026 CONTINUE
+10022 IF(.NOT.( z(i,j).lt.0.))GOTO 10027
+      kchar(i)=32-kchar(i)
+10027 CONTINUE
+10019 CONTINUE
+10020 WRITE(*,'(1x,i3,''|'',1000a)')j+1,(iform(kchar(i)),i=1,im),'|','| 
+     *'
+10017 CONTINUE
+10018 write(*,F1000)
+      WRITE(*,'(5x,1000i1)')(mod(i,10),i=1,im)
+      WRITE(*,'(14x,1000i1)')(mod(i/10,10),i=10,im)
+      if(im.ge.100)WRITE(*,'(104x,900i1)')(mod(i/100,10),i=100,im)
+      GOTO 10016
+10015 print*,'>>> ZERO MAP  <<<'
+10016 if(zinf)print*,' *** Infty value(s) (+ or -) in map ***'
+      if(znan)print*,' *** NaN value(s) (?) in map ***'
+      print*
+      RETURN
+      END
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/eq_regions_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/eq_regions_mod.F90	(revision 5133)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/eq_regions_mod.F90	(revision 5133)
@@ -0,0 +1,366 @@
+module eq_regions_mod
+!
+!     Purpose.
+!     --------
+!           eq_regions_mod provides the code to perform a high level 
+!           partitioning of the surface of a sphere into regions of
+!           equal area and small diameter.
+!           the type.
+!
+!     Background.
+!     -----------
+!     This Fortran version of eq_regions is a much cut down version of the 
+!     "Recursive Zonal Equal Area (EQ) Sphere Partitioning Toolbox" of the
+!     same name developed by Paul Leopardi at the University of New South Wales. 
+!     This version has been coded specifically for the case of partitioning the 
+!     surface of a sphere or S^dim (where dim=2) as denoted in the original code.
+!     Only a subset of the original eq_regions package has been coded to determine 
+!     the high level distribution of regions on a sphere, as the detailed 
+!     distribution of grid points to each region is left to IFS software.
+!     This is required to take into account the spatial distribution of grid 
+!     points in an IFS gaussian grid and provide an optimal (i.e. exact) 
+!     distribution of grid points over regions.
+!
+!     The following copyright notice for the eq_regions package is included from 
+!     the original MatLab release.
+!
+!     +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+!     + Release 1.10 2005-06-26                                                 +
+!     +                                                                         +
+!     + Copyright (c) 2004, 2005, University of New South Wales                 +
+!     +                                                                         +
+!     + Permission is hereby granted, free of charge, to any person obtaining   +
+!     + a copy of this software and associated documentation files (the         +
+!     + "Software"), to deal in the Software without restriction, including     +
+!     + without limitation the rights to use, copy, modify, merge, publish,     +
+!     + distribute, sublicense, and/or sell copies of the Software, and to      +
+!     + permit persons to whom the Software is furnished to do so, subject to   +
+!     + the following conditions:                                               +
+!     +                                                                         +
+!     + The above copyright notice and this permission notice shall be included +
+!     + in all copies or substantial portions of the Software.                  +
+!     +                                                                         +
+!     + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,         +
+!     + EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF      +
+!     + MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  +
+!     + IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY    +
+!     + CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,    +
+!     + TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE       +
+!     + SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.                  +
+!     +                                                                         +
+!     +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+!
+!     Author.
+!     -------
+!        George Mozdzynski *ECMWF*
+!
+!     Modifications.
+!     --------------
+!        Original : 2006-04-15
+!
+!--------------------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+
+IMPLICIT NONE
+
+SAVE
+
+PRIVATE
+
+PUBLIC eq_regions,l_regions_debug,n_regions_ns,n_regions_ew,n_regions,my_region_ns,my_region_ew
+
+real(kind=jprb) pi
+logical :: l_regions_debug=.false.
+integer(kind=jpim) :: n_regions_ns
+integer(kind=jpim) :: n_regions_ew
+integer(kind=jpim) :: my_region_ns
+integer(kind=jpim) :: my_region_ew
+integer(kind=jpim),allocatable :: n_regions(:)
+
+
+!$OMP THREADPRIVATE(l_regions_debug,my_region_ew,my_region_ns,n_regions_ew,n_regions_ns,pi,n_regions)
+
+CONTAINS
+
+subroutine eq_regions(N)
+!
+! eq_regions uses the zonal equal area sphere partitioning algorithm to partition
+! the surface of a sphere into N regions of equal area and small diameter.
+!
+integer(kind=jpim),intent(in) :: N
+integer(kind=jpim) :: n_collars,j
+real(kind=jprb),allocatable :: r_regions(:)
+real(kind=jprb) :: c_polar
+
+pi=2.0_jprb*asin(1.0_jprb)
+
+n_regions(:)=0
+
+if( N == 1 )then
+
+  !
+  ! We have only one region, which must be the whole sphere.
+  !
+  n_regions(1)=1
+  n_regions_ns=1
+
+else
+
+  !
+  ! Given N, determine c_polar
+  ! the colatitude of the North polar spherical cap.
+  !
+  c_polar = polar_colat(N)
+  !
+  ! Given N, determine the ideal angle for spherical collars.
+  ! Based on N, this ideal angle, and c_polar,
+  ! determine n_collars, the number of collars between the polar caps.
+  !
+  n_collars = num_collars(N,c_polar,ideal_collar_angle(N))
+  n_regions_ns=n_collars+2
+  !
+  ! Given N, c_polar and n_collars, determine r_regions,
+  ! a list of the ideal real number of regions in each collar,
+  ! plus the polar caps.
+  ! The number of elements is n_collars+2.
+  ! r_regions[1] is 1.
+  ! r_regions[n_collars+2] is 1.
+  ! The sum of r_regions is N.
+  allocate(r_regions(n_collars+2))
+  call ideal_region_list(N,c_polar,n_collars,r_regions)
+  !
+  ! Given N and r_regions, determine n_regions, a list of the natural number 
+  ! of regions in each collar and the polar caps.
+  ! This list is as close as possible to r_regions.
+  ! The number of elements is n_collars+2.
+  ! n_regions[1] is 1.
+  ! n_regions[n_collars+2] is 1.
+  ! The sum of n_regions is N.
+  !
+  call round_to_naturals(N,n_collars,r_regions)
+  deallocate(r_regions)
+  if( N /= sum(n_regions(:)) )then
+    write(*,'("eq_regions: N=",I10," sum(n_regions(:))=",I10)')N,sum(n_regions(:))
+    call abor1('eq_regions: N /= sum(n_regions)')
+  endif
+
+endif
+
+if( l_regions_debug )then
+  write(*,'("eq_regions: N=",I6," n_regions_ns=",I4)') N,n_regions_ns
+  do j=1,n_regions_ns
+    write(*,'("eq_regions: n_regions(",I4,")=",I4)') j,n_regions(j)
+  enddo
+endif
+n_regions_ew=maxval(n_regions(:))
+
+return
+end subroutine eq_regions
+
+function num_collars(N,c_polar,a_ideal) result(num_c)
+!
+!NUM_COLLARS The number of collars between the polar caps
+!
+! Given N, an ideal angle, and c_polar,
+! determine n_collars, the number of collars between the polar caps.
+!
+integer(kind=jpim),intent(in) :: N
+real(kind=jprb),intent(in) :: a_ideal,c_polar
+integer(kind=jpim) :: num_c
+logical enough
+enough = (N > 2) .and. (a_ideal > 0)
+if( enough )then
+  num_c = max(1,nint((pi-2.*c_polar)/a_ideal))
+else
+  num_c = 0
+endif
+return
+end function num_collars
+
+subroutine ideal_region_list(N,c_polar,n_collars,r_regions)
+!
+!IDEAL_REGION_LIST The ideal real number of regions in each zone
+!
+! List the ideal real number of regions in each collar, plus the polar caps.
+!
+! Given N, c_polar and n_collars, determine r_regions, a list of the ideal real 
+! number of regions in each collar, plus the polar caps.
+! The number of elements is n_collars+2.
+! r_regions[1] is 1.
+! r_regions[n_collars+2] is 1.
+! The sum of r_regions is N.
+!
+integer(kind=jpim),intent(in) :: N,n_collars
+real(kind=jprb),intent(in) :: c_polar
+real(kind=jprb),intent(out) :: r_regions(n_collars+2)
+integer(kind=jpim) :: collar_n
+real(kind=jprb) :: ideal_region_area,ideal_collar_area
+real(kind=jprb) :: a_fitting
+r_regions(:)=0.0_jprb
+r_regions(1) = 1.0_jprb
+if( n_collars > 0 )then
+  !
+  ! Based on n_collars and c_polar, determine a_fitting,
+  ! the collar angle such that n_collars collars fit between the polar caps.
+  !
+  a_fitting = (pi-2.0_jprb*c_polar)/float(n_collars)
+  ideal_region_area = area_of_ideal_region(N)
+  do collar_n=1,n_collars
+    ideal_collar_area = area_of_collar(c_polar+(collar_n-1)*a_fitting, &
+     & c_polar+collar_n*a_fitting)
+    r_regions(1+collar_n) = ideal_collar_area / ideal_region_area
+  enddo
+endif
+r_regions(2+n_collars) = 1.
+return
+end subroutine ideal_region_list
+
+function ideal_collar_angle(N) result(ideal)
+!
+! IDEAL_COLLAR_ANGLE The ideal angle for spherical collars of an EQ partition
+!
+! IDEAL_COLLAR_ANGLE(N) sets ANGLE to the ideal angle for the
+! spherical collars of an EQ partition of the unit sphere S^2 into N regions.
+!
+integer(kind=jpim),intent(in) :: N
+real(kind=jprb) :: ideal
+ideal = area_of_ideal_region(N)**(0.5_jprb)
+return
+end function ideal_collar_angle
+
+subroutine round_to_naturals(N,n_collars,r_regions)
+!
+! ROUND_TO_NATURALS Round off a given list of numbers of regions
+!
+! Given N and r_regions, determine n_regions, a list of the natural number 
+! of regions in each collar and the polar caps.
+! This list is as close as possible to r_regions, using rounding.
+! The number of elements is n_collars+2.
+! n_regions[1] is 1.
+! n_regions[n_collars+2] is 1.
+! The sum of n_regions is N.
+!
+integer(kind=jpim),intent(in) :: N,n_collars
+real(kind=jprb),intent(in) :: r_regions(n_collars+2)
+integer(kind=jpim) :: zone_n
+real(kind=jprb) :: discrepancy
+n_regions(1:n_collars+2) = r_regions(:)
+discrepancy = 0.0_jprb
+do zone_n = 1,n_collars+2
+    n_regions(zone_n) = nint(r_regions(zone_n)+discrepancy);
+    discrepancy = discrepancy+r_regions(zone_n)-float(n_regions(zone_n));
+enddo
+return
+end subroutine round_to_naturals
+
+function polar_colat(N) result(polar_c)
+!
+! Given N, determine the colatitude of the North polar spherical cap.
+!
+integer(kind=jpim),intent(in) :: N
+real(kind=jprb) :: area
+real(kind=jprb) :: polar_c
+if( N == 1 ) polar_c=pi
+if( N == 2 ) polar_c=pi/2.0_jprb
+if( N > 2 )then
+  area=area_of_ideal_region(N)
+  polar_c=sradius_of_cap(area)
+endif
+return
+end function polar_colat
+
+function area_of_ideal_region(N) result(area)
+!
+! AREA_OF_IDEAL_REGION(N) sets AREA to be the area of one of N equal
+! area regions on S^2, that is 1/N times AREA_OF_SPHERE.
+!
+integer(kind=jpim),intent(in) :: N
+real(kind=jprb) :: area_of_sphere
+real(kind=jprb) :: area
+area_of_sphere = (2.0_jprb*pi**1.5_jprb/gamma(1.5_jprb))
+area = area_of_sphere/float(N)
+return
+end function area_of_ideal_region
+
+function sradius_of_cap(area) result(sradius)
+!
+! SRADIUS_OF_CAP(AREA) returns the spherical radius of
+! an S^2 spherical cap of area AREA.
+!
+real(kind=jprb),intent(in) :: area
+real(kind=jprb) :: sradius
+sradius = 2.0_jprb*asin(sqrt(area/pi)/2.0_jprb)
+return
+end function sradius_of_cap
+
+function area_of_collar(a_top, a_bot) result(area)
+!
+! AREA_OF_COLLAR Area of spherical collar
+!
+! AREA_OF_COLLAR(A_TOP, A_BOT) sets AREA to be the area of an S^2 spherical 
+! collar specified by A_TOP, A_BOT, where A_TOP is top (smaller) spherical radius,
+! A_BOT is bottom (larger) spherical radius.
+!
+real(kind=jprb),intent(in) :: a_top,a_bot
+real(kind=jprb) area
+area = area_of_cap(a_bot) - area_of_cap(a_top)
+return
+end function area_of_collar
+
+function area_of_cap(s_cap) result(area)
+!
+! AREA_OF_CAP Area of spherical cap
+!
+! AREA_OF_CAP(S_CAP) sets AREA to be the area of an S^2 spherical
+! cap of spherical radius S_CAP.
+!
+real(kind=jprb),intent(in) :: s_cap
+real(kind=jprb) area
+area = 4.0_jprb*pi * sin(s_cap/2.0_jprb)**2
+return
+end function area_of_cap
+
+function gamma(x) result(gamma_res)
+real(kind=jprb),intent(in) :: x
+real(kind=jprb) :: gamma_res
+real(kind=jprb) :: p0,p1,p2,p3,p4,p5,p6,p7,p8,p9,p10,p11,p12,p13
+real(kind=jprb) :: w,y
+integer(kind=jpim) :: k,n
+parameter (&
+& p0 =   0.999999999999999990e+00_jprb,&
+& p1 =  -0.422784335098466784e+00_jprb,&
+& p2 =  -0.233093736421782878e+00_jprb,&
+& p3 =   0.191091101387638410e+00_jprb,&
+& p4 =  -0.024552490005641278e+00_jprb,&
+& p5 =  -0.017645244547851414e+00_jprb,&
+& p6 =   0.008023273027855346e+00_jprb)
+parameter (&
+& p7 =  -0.000804329819255744e+00_jprb,&
+& p8 =  -0.000360837876648255e+00_jprb,&
+& p9 =   0.000145596568617526e+00_jprb,&
+& p10 = -0.000017545539395205e+00_jprb,&
+& p11 = -0.000002591225267689e+00_jprb,&
+& p12 =  0.000001337767384067e+00_jprb,&
+& p13 = -0.000000199542863674e+00_jprb)
+n = nint(x - 2)
+w = x - (n + 2)
+y = ((((((((((((p13 * w + p12) * w + p11) * w + p10) *&
+&    w + p9) * w + p8) * w + p7) * w + p6) * w + p5) *&
+&    w + p4) * w + p3) * w + p2) * w + p1) * w + p0
+if (n .gt. 0) then
+  w = x - 1
+  do k = 2, n
+    w = w * (x - k)
+  end do
+else
+  w = 1
+  do k = 0, -n - 1
+    y = y * (x + k)
+  end do
+end if
+gamma_res = w / y
+return
+end function gamma
+
+end module eq_regions_mod
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/gstats.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/gstats.F90	(revision 5133)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/gstats.F90	(revision 5133)
@@ -0,0 +1,309 @@
+SUBROUTINE GSTATS(KNUM,KSWITCH)
+
+!**** *GSTATS*  - Gather timing statistics
+
+!     PURPOSE.
+!     --------
+!       To gather timings for subsequent output by routine STATS_OUTPUT 
+
+
+!**   INTERFACE.
+!     ----------
+!       *CALL* *GSTATS(KNUM,KSWITCH)
+
+!        EXPLICIT ARGUMENTS
+!        --------------------
+!        KNUM - timing event number (for list of already defined events
+!               see routine STATS_OUTPUT)
+!        KSWITCH  - KSWITCH=0 - switch on timer
+!                   KSWITCH=1 - switch off timer
+!                   KSWITCH=2 - suspend timer
+!                   KSWITCH=3 - resume  timer
+
+!        IMPLICIT ARGUMENTS
+!        --------------------
+!        Module YOMSTATS
+
+!     METHOD.
+!     -------
+
+
+!     EXTERNALS.   USER_CLOCK - timing routine
+!     ----------   MPL_BARRIER - syncronization of processors
+
+!     REFERENCE.
+!     ----------
+!        ECMWF Research Department documentation of the IFS
+
+!     AUTHOR.
+!     -------
+!        Mats Hamrud ECMWF
+
+!     MODIFICATIONS.
+!     --------------
+!        ORIGINAL : 98-11-15
+!        D.Salmond: 02-02-25  Return if not master thread when called from a 
+!                             parallel region. 
+!        J.Hague:   03-06-11  Memory tracing (for NSTATS_MEM MPI tasks)
+!     ------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB     ,JPIB
+USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK
+
+USE YOMGSTATS  
+!USE MPL_MODULE   ! MPL 28.11.08
+USE YOMOML
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM),INTENT(IN) :: KNUM
+INTEGER(KIND=JPIM),INTENT(IN) :: KSWITCH
+
+INTEGER(KIND=JPIM) :: IMOD,ICALL
+INTEGER(KIND=JPIM) :: IIMEM, IIPAG, IIMEMC
+INTEGER(KIND=JPIB) :: IMEM, IMEMH, IMEMS, IMEMC, IPAG, INUM
+INTEGER(KIND=JPIB) :: GETRSS, GETHWM, GETSTK, GETCURHEAP, GETPAG
+EXTERNAL GETRSS, GETHWM, GETSTK, GETCURHEAP, GETPAG
+REAL(KIND=JPRB) :: ZTIMED,ZCLOCK,ZTIME,ZTCPU,ZVCPU
+REAL(KIND=JPRB) :: ZLAST_PAR_TIME
+LOGICAL :: LLFIRST=.TRUE.
+LOGICAL :: LLMFIRST=.TRUE.
+  CHARACTER(LEN=32), SAVE :: CCDESC_DRHOOK(JPMAXSTAT)
+  CHARACTER(LEN=32), SAVE :: CCDESC_BARR(JPMAXSTAT)
+SAVE ZLAST_PAR_TIME
+SAVE IIMEM, IIPAG, IIMEMC
+
+INTEGER(KIND=JPIM),SAVE :: NUM_THREADS
+REAL(KIND=JPRB),ALLOCATABLE,SAVE :: ZHOOK_HANDLE(:)
+REAL(KIND=JPRB),SAVE :: ZHOOK_HANDLE_COMMS, ZHOOK_HANDLE_COMMS1
+REAL(KIND=JPRB),SAVE :: ZHOOK_HANDLE_TRANS
+REAL(KIND=JPRB),SAVE :: ZHOOK_HANDLE_BARR
+CHARACTER*4 CC
+
+INTEGER(KIND=JPIM) :: NMAX_STATS, KULNAM
+
+INTERFACE
+#include "user_clock.h"
+END INTERFACE
+
+! write(0,*) "GSTATS:LSTATS,JPMAXSTAT,LGSTATS_LABEL,KNUM=",LSTATS,JPMAXSTAT,LGSTATS_LABEL,KNUM
+
+IF(LSTATS) THEN
+
+  IF(.NOT.ALLOCATED(ZHOOK_HANDLE))THEN
+    NUM_THREADS=OML_MAX_THREADS()
+    ALLOCATE(ZHOOK_HANDLE(NUM_THREADS))
+  ENDIF
+
+  IF(LGSTATS_LABEL)THEN
+    DO INUM=1,JPMAXSTAT
+      WRITE(CC,'(I4)')INUM
+      CCDESC_BARR(INUM)='>BAR-'//CCDESC(INUM)(1:21)//'('//CC//')'
+    ENDDO
+    DO INUM=1,JPMAXSTAT
+      WRITE(CC,'(I4)')INUM
+!     write(6,*) inum,cctype(inum)
+      IF(CCTYPE(INUM).EQ."TRS".OR.CCTYPE(INUM).EQ.'MP-'.OR.CCTYPE(INUM).EQ.'MPL'&
+                            & .OR.CCTYPE(INUM).EQ.'BAR'.OR.CCTYPE(INUM).EQ.'OMP') THEN
+        CCDESC_DRHOOK(INUM)='>'//CCTYPE(INUM)//'-'//CCDESC(INUM)(1:21)//'('//CC//')'
+      ENDIF
+    ENDDO
+    LGSTATS_LABEL=.FALSE.
+  ENDIF
+!     ------------------------------------------------------------------
+
+!J  IF((KNUM > 1000 .AND.KNUM < 2001).AND.(.NOT.LSTATS_OMP))GOTO 99999
+!J  IF((KNUM > 500  .AND.KNUM < 1001).AND.(.NOT.LSTATS_COMMS))GOTO 99999
+  IF(OML_MY_THREAD() > 1)GOTO 99999
+
+!J  IF(KNUM/=0) THEN
+!J    IF(LSYNCSTATS .AND.(KSWITCH==0.OR. KSWITCH==2)) THEN
+!J      IF(.NOT.OML_IN_PARALLEL().AND. KNUM < 500 )THEN
+!J        IF(LHOOK)CALL DR_HOOK(CCDESC_BARR(KNUM),0,ZHOOK_HANDLE_BARR)
+!J        CALL MPL_BARRIER(CDSTRING='GSTATS:')
+!J        IF(LHOOK)CALL DR_HOOK(CCDESC_BARR(KNUM),1,ZHOOK_HANDLE_BARR)
+!J      ENDIF
+!J    ENDIF
+!J  ENDIF
+
+  IF (LHOOK .AND. (KSWITCH == 0 .OR. KSWITCH == 1)) THEN
+!   write(0,*) "KNUM,SWITCH=",KNUM,KSWITCH
+!   write(0,*) "CCTYPE=",CCTYPE(KNUM)
+!   write(0,*) "CCDESC_DRHOOK=",CCDESC_DRHOOK(KNUM)
+    IF(CCTYPE(KNUM).EQ."TRS")THEN
+      CALL DR_HOOK(CCDESC_DRHOOK(KNUM),KSWITCH,ZHOOK_HANDLE_TRANS)
+    ELSEIF(CCTYPE(KNUM).EQ.'MP-')THEN
+      CALL DR_HOOK(CCDESC_DRHOOK(KNUM),KSWITCH,ZHOOK_HANDLE_COMMS)
+    ELSEIF(CCTYPE(KNUM).EQ.'MPL'.AND.KNUM.NE.682)THEN
+      CALL DR_HOOK(CCDESC_DRHOOK(KNUM),KSWITCH,ZHOOK_HANDLE_COMMS1)
+    ELSEIF(CCTYPE(KNUM).EQ.'OMP')THEN
+!     CALL DR_HOOK(CCDESC_DRHOOK(KNUM),KSWITCH,ZHOOK_HANDLE)
+! MPL 1.12.08 : erreur a la compilation car zhook_handle est un tableau et non un
+! scalaire (PKEY)
+      CALL DR_HOOK(CCDESC_DRHOOK(KNUM),KSWITCH,ZTIME)
+    ELSEIF(CCTYPE(KNUM).EQ.'BAR')THEN
+      CALL DR_HOOK(CCDESC_DRHOOK(KNUM),KSWITCH,ZHOOK_HANDLE_BARR)
+    ENDIF
+  ENDIF
+
+  CALL USER_CLOCK(PELAPSED_TIME=ZCLOCK)
+  IF (LSTATSCPU.OR.KNUM==0) THEN
+    CALL USER_CLOCK(PTOTAL_CP=ZTCPU,PVECTOR_CP=ZVCPU)
+  ELSE
+    ZTCPU = 0.0_JPRB
+    ZVCPU = 0.0_JPRB
+  ENDIF
+
+  IF (LLFIRST) THEN
+
+!   write(0,*) "JPMAXSTAT:2=",JPMAXSTAT
+
+    NCALLS(:) = 0
+    TIMESUM(:) = 0.0_JPRB
+    TIMESQSUM(:) = 0.0_JPRB
+    TIMEMAX(:) = 0.0_JPRB
+    TIMESUMB(:) = 0.0_JPRB
+    TTCPUSUM(:) = 0.0_JPRB
+    TVCPUSUM(:) = 0.0_JPRB
+    TIMELCALL(:) = ZCLOCK
+    CCDESC=""
+    CCTYPE=""
+    NTMEM      = 0
+    NTMEM(:,5) = 99999999
+    IIMEM=0
+    IIPAG=0
+    IIMEMC=0
+    TIME_LAST_CALL = ZCLOCK
+    ZLAST_PAR_TIME=ZCLOCK
+    LLFIRST = .FALSE.
+  ENDIF
+
+  IF(KNUM < 0.OR. KNUM > JPMAXSTAT) CALL ABOR1('GSTATS')
+  IF(KSWITCH == 0.OR. KSWITCH == 1) THEN
+    NCALLS(KNUM) = NCALLS(KNUM)+1
+  ENDIF
+  IMOD = MOD(NCALLS(KNUM),2)
+  IF(.NOT.((KSWITCH == 0.AND. IMOD == 1) .OR.&
+   &(KSWITCH == 2.AND. IMOD == 1) .OR.&
+   &(KSWITCH == 3.AND. IMOD == 1) .OR.&
+   &(KSWITCH == 1.AND. IMOD == 0))) THEN
+    WRITE(JPERR,*) 'KNUM,KSWITCH,IMOD,NCALLS(KNUM)',&
+     &KNUM,KSWITCH,IMOD,NCALLS(KNUM)
+    CALL ABOR1('GSTATS')
+  ENDIF
+
+  IF( KSWITCH == 0 ) THEN
+! Start timing event
+    IF(KNUM < 500) THEN
+      ZTIMED = ZCLOCK-TIME_LAST_CALL
+    ELSE
+      ZTIMED = ZCLOCK - ZLAST_PAR_TIME
+    ENDIF
+    TIMESUMB(KNUM) = TIMESUMB(KNUM)+ZTIMED
+    THISTIME(KNUM) = 0.0_JPRB
+    TIMELCALL(KNUM) = ZCLOCK
+    TTCPULCALL(KNUM) = ZTCPU
+    TVCPULCALL(KNUM) = ZVCPU
+    THISTCPU(KNUM) = 0.0_JPRB
+    THISVCPU(KNUM) = 0.0_JPRB
+    IF(MYPROC_STATS.LE.NSTATS_MEM.AND.MYPROC_STATS.NE.0) THEN
+!     CALL getrss(IMEM)
+!     IMEM = getrss()/1024
+      IPAG = getpag()
+      IMEMH = gethwm()/1024
+      IMEMS = getstk()/1024
+      IMEMC = 0
+      IF(LSTATS_ALLOC) IMEMC = GETCURHEAP()/1024
+      IF(IMEM > IIMEM.OR.IPAG > IIPAG.OR.(LSTATS_ALLOC.AND.(IMEMC.NE.IIMEMC))) THEN
+        IF(LLMFIRST) THEN
+          WRITE(0,*) ".---------------------------------------------------------"
+          WRITE(0,*) "| Memory trace details"
+          WRITE(0,*) "| --------------------"
+          WRITE(0,*) "| Memory examined at each GSTATS call if NSTATS_MEM>0."
+          WRITE(0,*) "| Header for each trace line is:"    
+          WRITE(0,*) "|"
+          WRITE(0,*) "|   RSS_INC: Increase in RSS_MAX (KB)"
+          WRITE(0,*) "|   RSS_MAX: Maximum real working set so far (KB)"
+          WRITE(0,*) "|   HEAP_MX: High Water Mark for heap so far (KB)"
+          WRITE(0,*) "|   STK:     Current Stack usage (KB)"
+          WRITE(0,*) "|   PGS:     Page faults w I/O since last trace line"
+          WRITE(0,*) "|   CALL:    Number of gstats call"
+          WRITE(0,*) "|   HEAP:    Current malloc'd total (KB)"
+          WRITE(0,*) "|" 
+          WRITE(0,*) "| Trace line written for NSTATS_MEM MPI tasks if RSS_MAX"
+          WRITE(0,*) "| RSS_MAX increases, PGS>0, or HEAP changed"
+          WRITE(0,*) "| (if LTATS_ALLOC=.TRUE.)"
+          WRITE(0,*) "`---------------------------------------------------------"
+          WRITE(0,*) ""
+          WRITE(0,'(A10,A5,21X,A7,2A8,A7,A5,A5,A8)') &
+           & "MEMORY    "," KNUM","RSS_INC"," RSS_MAX"," HEAP_MX","    STK", &
+           & "  PGS"," CALL","    HEAP"
+          LLMFIRST=.FALSE.
+        ENDIF
+        WRITE(0,'(A10,I5,1X,A20,1X,I6,2(1X,I7),1X,I6,1X,I4,1X,I4,1X,I7)') &
+             & "MEMORY bfr",KNUM,CCDESC(KNUM),IMEM-IIMEM,IMEM,IMEMH,IMEMS, &
+             & IPAG-IIPAG,(NCALLS(KNUM)+1)/2,IMEMC
+      ENDIF
+      NTMEM(KNUM,2)=IMEM
+      IIMEM=IMEM
+      IIPAG=IPAG
+      IIMEMC=IMEMC
+    ENDIF
+  ELSEIF( KSWITCH == 1 ) THEN
+! Finish timing event
+    ZTIME = THISTIME(KNUM)+(ZCLOCK-TIMELCALL(KNUM))
+    TIMESUM(KNUM) = TIMESUM(KNUM)+ZTIME
+    TIMESQSUM(KNUM) = TIMESQSUM(KNUM)+ZTIME**2
+    TIMEMAX(KNUM) = MAX(TIMEMAX(KNUM),ZTIME)
+    TTCPUSUM(KNUM) = TTCPUSUM(KNUM)+THISTCPU(KNUM)+ZTCPU-TTCPULCALL(KNUM)
+    TVCPUSUM(KNUM) = TVCPUSUM(KNUM)+THISVCPU(KNUM)+ZVCPU-TVCPULCALL(KNUM)
+    IF(MYPROC_STATS.LE.NSTATS_MEM.AND.MYPROC_STATS.NE.0) THEN
+!     CALL getrss(IMEM)
+      IMEM = GETRSS()/1024
+      IPAG = GETPAG()
+      IMEMH = GETHWM()/1024
+      IMEMS = GETSTK()/1024
+      IMEMC = 0
+      IF(LSTATS_ALLOC) IMEMC = GETCURHEAP()/1024
+      IF(IMEM > IIMEM.OR.IPAG > IIPAG.OR.(LSTATS_ALLOC.AND.(IMEMC.NE.IIMEMC))) THEN
+        WRITE(0,'(A10,I5,1X,A20,1X,I6,2(1X,I7),1X,I6,1X,I4,1X,I4,1X,I7)') &
+             & "MEMORY aft ",KNUM,CCDESC(KNUM),IMEM-IIMEM,IMEM,IMEMH,IMEMS, &
+             & IPAG-IIPAG,NCALLS(KNUM)/2,IMEMC
+      ENDIF
+      IIMEM=IMEM
+      IIPAG=IPAG
+      IIMEMC=IMEMC 
+      IMEM=IMEM-NTMEM(KNUM,2)
+      NTMEM(KNUM,4)=NTMEM(KNUM,4)+IMEM
+      IF(IMEM > NTMEM(KNUM,1)) THEN
+        NTMEM(KNUM,1)=IMEM
+        NTMEM(KNUM,3)=NCALLS(KNUM)
+      ENDIF
+      IF(IMEM < NTMEM(KNUM,5)) NTMEM(KNUM,5)=IMEM
+    ENDIF
+  ELSEIF( KSWITCH == 2 ) THEN
+! Suspend timing event
+    ZTIMED = ZCLOCK-TIMELCALL(KNUM)
+    THISTIME(KNUM) = THISTIME(KNUM)+ZTIMED
+    THISTCPU(KNUM) = THISTCPU(KNUM)+ZTCPU-TTCPULCALL(KNUM)
+    THISVCPU(KNUM) = THISVCPU(KNUM)+ZVCPU-TVCPULCALL(KNUM)
+  ELSEIF( KSWITCH == 3 ) THEN
+! Resume timing event
+    TIMELCALL(KNUM) = ZCLOCK
+    TTCPULCALL(KNUM) = ZTCPU
+    TVCPULCALL(KNUM) = ZVCPU
+  ENDIF
+  TIME_LAST_CALL = ZCLOCK
+  IF(KNUM > 500.OR.KNUM == 102.OR.KNUM == 103) ZLAST_PAR_TIME = ZCLOCK
+!   Trace stats
+  NCALLS_TOTAL = NCALLS_TOTAL+1
+  IF (LTRACE_STATS .AND. NCALLS_TOTAL <= NTRACE_STATS) THEN
+    ICALL = NCALLS_TOTAL
+    TIME_TRACE(ICALL) = ZCLOCK
+    NCALL_TRACE(ICALL) = (JPMAXSTAT+1)*KSWITCH+KNUM
+  ENDIF
+
+ENDIF
+
+99999 CONTINUE
+END SUBROUTINE GSTATS
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/radlsw.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/radlsw.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/radlsw.F90	(revision 5133)
@@ -15,5 +15,5 @@
  & PFLUX,PFLUC,PFSDN ,PFSUP , PFSCDN , PFSCUP)
 
-use write_field_phy
+USE lmdz_writefield_phy, ONLY: writefield_phy
 
 !**** *RADLSW* - INTERFACE TO ECMWF LW AND SW RADIATION SCHEMES
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/read_rsun_rrtm.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/read_rsun_rrtm.F90	(revision 5133)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/read_rsun_rrtm.F90	(revision 5133)
@@ -0,0 +1,108 @@
+SUBROUTINE read_rsun_rrtm(debut)
+
+!****************************************************************************************
+! This routine will read the solar constant fraction per band
+!
+! Olivier Boucher with inputs from Marion Marchand 
+!****************************************************************************************
+
+  USE netcdf95, ONLY: nf95_close, nf95_inq_varid, nf95_open, nf95_gw_var
+  USE netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_nowrite
+
+  USE phys_cal_mod, ONLY : days_elapsed, year_len
+
+  USE lmdz_phys_mpi_data, ONLY: is_mpi_root
+  USE lmdz_phys_omp_data, ONLY: is_omp_root
+  USE lmdz_phys_para
+  USE lmdz_abort_physic, ONLY: abort_physic
+
+  USE YOESW, ONLY : RSUN
+
+  IMPLICIT NONE
+
+  INCLUDE "clesphys.h"
+
+  ! Input arguments
+  LOGICAL, INTENT(IN) :: debut
+
+! Local variables
+  INTEGER :: ncid, dimid, varid, ncerr, nbday
+  REAL, ALLOCATABLE :: wlen(:), time(:)
+  REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: SSI_FRAC
+!$OMP THREADPRIVATE(SSI_FRAC)
+  REAL, ALLOCATABLE, SAVE, DIMENSION(:) :: TSI(:)
+!$OMP THREADPRIVATE(TSI)
+
+  INTEGER, SAVE :: day_pre=1
+!$OMP THREADPRIVATE(day_pre)
+
+!--only one processor reads
+    IF (debut) THEN 
+
+    ALLOCATE(SSI_FRAC(NSW,year_len))
+    ALLOCATE(TSI(year_len))
+
+    IF (is_mpi_root.AND.is_omp_root) THEN
+
+       CALL nf95_open('solarforcing.nc', NF90_NOWRITE, ncid)
+
+       CALL nf95_inq_varid(ncid, 'wlen', varid)
+       CALL nf95_gw_var(ncid, varid, wlen)
+
+       CALL nf95_inq_varid(ncid, 'time', varid)
+       CALL nf95_gw_var(ncid, varid, time)
+
+       IF (NSW.NE.size(wlen)) THEN 
+         PRINT *,'read_rsun_rrtm NSW <> wlen = ',NSW, size(wlen)
+         CALL abort_physic('read_rsun_rrtm','size of SSI is different from NSW',1)
+       ENDIF
+
+!--test if time is different from year_len but allow a mismatch of 1 day
+       IF (size(time).NE.year_len.AND.size(time).NE.year_len+1) THEN
+         PRINT *,'read_rsun_rrtm time <> year_len = ', size(time), year_len
+         CALL abort_physic('read_rsun_rrtm','time dim should be the number of days in year',1)
+       ENDIF
+!--warning only if forcing file has 366 days but year_len has only 365
+       IF (size(time).EQ.year_len+1) THEN 
+         PRINT *,'Warning read_rsun_rrtm uses a leap year rsun for a noleap year'
+       ENDIF
+
+       CALL nf95_inq_varid(ncid, 'ssi_frac', varid)
+       ncerr = nf90_get_var(ncid, varid, SSI_FRAC)
+
+       CALL nf95_inq_varid(ncid, 'tsi', varid)
+       ncerr = nf90_get_var(ncid, varid, TSI)
+
+       CALL nf95_close(ncid)
+
+       DO nbday=1, year_len
+         IF (ABS(SUM(SSI_FRAC(:,nbday))-1.).GT.1.e-6) THEN 
+           PRINT *,'somme SSI_FRAC=', SUM(SSI_FRAC(:,nbday))
+           CALL abort_physic('read_rsun_rrtm','somme SSI_FRAC <> 1',1)
+         ENDIF
+       ENDDO
+     
+    ENDIF ! is_mpi_root .AND. is_omp_root
+
+!$OMP BARRIER
+    CALL bcast(SSI_FRAC)
+    CALL bcast(TSI)
+
+    ENDIF
+
+!--only read at beginning of day
+!--day in year is provided as days_elapsed since the beginning of the year +1
+    IF (debut.OR.days_elapsed+1.NE.day_pre) THEN
+
+!--keep memory of previous day
+      day_pre=days_elapsed+1
+
+!--copy 
+      RSUN(1:NSW)=SSI_FRAC(:,days_elapsed+1)
+      solaire=TSI(days_elapsed+1)
+
+      print *,'READ_RSUN_RRTM day=', days_elapsed+1,' solaire=', solaire, ' RSUN=', RSUN(1:NSW)
+
+    ENDIF !--fin allocation
+
+END SUBROUTINE read_rsun_rrtm
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/readaerosol_optic_rrtm.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/readaerosol_optic_rrtm.F90	(revision 5133)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/readaerosol_optic_rrtm.F90	(revision 5133)
@@ -0,0 +1,331 @@
+! $Id: readaerosol_optic_rrtm.F90 4124 2022-04-08 14:47:04Z dcugnet $
+!
+SUBROUTINE readaerosol_optic_rrtm(debut, aerosol_couple, ok_alw, ok_volcan, &
+     flag_aerosol, flag_bc_internal_mixture, itap, rjourvrai, &
+     pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &
+     tr_seri, mass_solu_aero, mass_solu_aero_pi, &
+     tau_aero, piz_aero, cg_aero, &
+     tausum_aero, drytausum_aero, tau3d_aero )
+
+  ! This routine will :
+  ! 1) recevie the aerosols(already read and interpolated) corresponding to flag_aerosol
+  ! 2) calculate the optical properties for the aerosols
+  !
+
+  USE dimphy
+  USE aero_mod
+  USE phys_local_var_mod, only: sconcso4,sconcno3,sconcoa,sconcbc,sconcss,sconcdust, &
+       concso4,concno3,concoa,concbc,concss,concdust,loadso4,loadoa,loadbc,loadss,loaddust, &
+       loadno3,load_tmp1,load_tmp2,load_tmp3,load_tmp4,load_tmp5,load_tmp6,load_tmp7, & 
+       load_tmp8,load_tmp9,load_tmp10
+
+  USE infotrac_phy, ONLY: tracers, nqtot, nbtr
+  USE YOMCST
+
+  IMPLICIT NONE
+
+  include "clesphys.h"
+
+  ! Input arguments
+  !****************************************************************************************
+  LOGICAL, INTENT(IN)                      :: debut
+  LOGICAL, INTENT(IN)                      :: aerosol_couple
+  LOGICAL, INTENT(IN)                      :: ok_alw
+  LOGICAL, INTENT(IN)                      :: ok_volcan
+  INTEGER, INTENT(IN)                      :: flag_aerosol
+  LOGICAL, INTENT(IN)                      :: flag_bc_internal_mixture
+  INTEGER, INTENT(IN)                      :: itap
+  REAL, INTENT(IN)                         :: rjourvrai
+  REAL, INTENT(IN)                         :: pdtphys
+  REAL, DIMENSION(klon,klev), INTENT(IN)   :: pplay
+  REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs
+  REAL, DIMENSION(klon,klev), INTENT(IN)   :: t_seri
+  REAL, DIMENSION(klon,klev), INTENT(IN)   :: rhcl   ! humidite relative ciel clair
+  REAL, DIMENSION(klev), INTENT(IN)        :: presnivs
+  REAL, DIMENSION(klon,klev,nbtr), INTENT(IN) :: tr_seri ! concentration tracer
+
+  ! Output arguments
+  !****************************************************************************************
+  REAL, DIMENSION(klon,klev), INTENT(OUT)     :: mass_solu_aero    ! Total mass for all soluble aerosols
+  REAL, DIMENSION(klon,klev), INTENT(OUT)     :: mass_solu_aero_pi !     -"-     preindustrial values
+  REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: tau_aero    ! Aerosol optical thickness
+  REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: piz_aero    ! Single scattering albedo aerosol
+  REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: cg_aero     ! asymmetry parameter aerosol
+  REAL, DIMENSION(klon,nwave,naero_tot), INTENT(OUT)       :: tausum_aero
+  REAL, DIMENSION(klon,naero_tot), INTENT(OUT)             :: drytausum_aero
+  REAL, DIMENSION(klon,klev,nwave,naero_tot), INTENT(OUT)  :: tau3d_aero
+
+  ! Local variables
+  !****************************************************************************************
+  REAL, DIMENSION(klon)        :: aerindex      ! POLDER aerosol index 
+  REAL, DIMENSION(klon,klev)   :: sulfacc       ! SO4 accumulation concentration [ug/m3]
+  REAL, DIMENSION(klon,klev)   :: sulfcoarse    ! SO4 coarse concentration [ug/m3]
+  REAL, DIMENSION(klon,klev)   :: bcsol         ! BC soluble concentration [ug/m3]
+  REAL, DIMENSION(klon,klev)   :: bcins         ! BC insoluble concentration [ug/m3]
+  REAL, DIMENSION(klon,klev)   :: pomsol        ! POM soluble concentration [ug/m3]
+  REAL, DIMENSION(klon,klev)   :: pomins        ! POM insoluble concentration [ug/m3]
+  REAL, DIMENSION(klon,klev)   :: cidust        ! DUST aerosol concentration  [ug/m3]
+  REAL, DIMENSION(klon,klev)   :: sscoarse      ! SS Coarse concentration [ug/m3]
+  REAL, DIMENSION(klon,klev)   :: sssupco       ! SS Super Coarse concentration [ug/m3]
+  REAL, DIMENSION(klon,klev)   :: ssacu         ! SS Acumulation concentration [ug/m3]
+  REAL, DIMENSION(klon,klev)   :: nitracc       ! nitrate accumulation concentration [ug/m3]
+  REAL, DIMENSION(klon,klev)   :: nitrcoarse    ! nitrate coarse concentration [ug/m3]
+  REAL, DIMENSION(klon,klev)   :: nitrinscoarse ! nitrate insoluble coarse concentration [ug/m3]
+  REAL, DIMENSION(klon,klev)   :: sulfacc_pi
+  REAL, DIMENSION(klon,klev)   :: sulfcoarse_pi
+  REAL, DIMENSION(klon,klev)   :: bcsol_pi
+  REAL, DIMENSION(klon,klev)   :: bcins_pi
+  REAL, DIMENSION(klon,klev)   :: pomsol_pi
+  REAL, DIMENSION(klon,klev)   :: pomins_pi
+  REAL, DIMENSION(klon,klev)   :: cidust_pi
+  REAL, DIMENSION(klon,klev)   :: sscoarse_pi
+  REAL, DIMENSION(klon,klev)   :: sssupco_pi
+  REAL, DIMENSION(klon,klev)   :: ssacu_pi
+  REAL, DIMENSION(klon,klev)   :: nitracc_pi
+  REAL, DIMENSION(klon,klev)   :: nitrcoarse_pi
+  REAL, DIMENSION(klon,klev)   :: nitrinscoarse_pi
+  REAL, DIMENSION(klon,klev)   :: pdel, zrho
+  REAL, DIMENSION(klon,klev,naero_tot) :: m_allaer
+  REAL, DIMENSION(klon,klev,naero_tot) :: m_allaer_pi !RAF  
+
+  integer :: id_ASBCM, id_ASPOMM, id_ASSO4M, id_ASMSAM, id_CSSO4M, id_CSMSAM, id_SSSSM
+  integer :: id_CSSSM, id_ASSSM, id_CIDUSTM, id_AIBCM, id_AIPOMM, id_ASNO3M, id_CSNO3M, id_CINO3M
+  INTEGER :: k, i, iq, itr
+
+  !--air density
+  zrho(:,:)=pplay(:,:)/t_seri(:,:)/RD                     !--kg/m3
+
+  !****************************************************************************************
+  ! 1) Get aerosol mass
+  !    
+  !****************************************************************************************
+  !
+  !
+  IF (aerosol_couple) THEN   !--we get aerosols from tr_seri array from INCA
+     !
+     !--copy fields from INCA tr_seri 
+     !--convert to ug m-3 unit for consistency with offline fields
+     !
+     itr = 0
+     DO iq = 1,nqtot
+        IF(.NOT. tracers(iq)%isInPhysics) CYCLE
+        itr = itr+1
+        SELECT CASE(trim(tracers(iq)%name))
+           CASE ("ASBCM");  id_ASBCM  = itr
+           CASE ("ASPOMM"); id_ASPOMM = itr
+           CASE ("ASSO4M"); id_ASSO4M = itr
+           CASE ("ASMSAM"); id_ASMSAM = itr
+           CASE ("CSSO4M"); id_CSSO4M = itr
+           CASE ("CSMSAM"); id_CSMSAM = itr
+           CASE ("SSSSM");  id_SSSSM  = itr
+           CASE ("CSSSM");  id_CSSSM  = itr
+           CASE ("ASSSM");  id_ASSSM  = itr
+           CASE ("CIDUSTM");id_CIDUSTM= itr
+           CASE ("AIBCM");  id_AIBCM  = itr
+           CASE ("AIPOMM"); id_AIPOMM = itr
+           CASE ("ASNO3M"); id_ASNO3M = itr
+           CASE ("CSNO3M"); id_CSNO3M = itr
+           CASE ("CINO3M"); id_CINO3M = itr
+        END SELECT
+     END DO
+
+     bcsol(:,:)        =   tr_seri(:,:,id_ASBCM)                         *zrho(:,:)*1.e9  ! ASBCM
+     pomsol(:,:)       =   tr_seri(:,:,id_ASPOMM)                        *zrho(:,:)*1.e9  ! ASPOMM
+     sulfacc(:,:)      =  (tr_seri(:,:,id_ASSO4M)+tr_seri(:,:,id_ASMSAM))*zrho(:,:)*1.e9  ! ASSO4M (=SO4) + ASMSAM (=MSA)
+     sulfcoarse(:,:)   =  (tr_seri(:,:,id_CSSO4M)+tr_seri(:,:,id_CSMSAM))*zrho(:,:)*1.e9  ! CSSO4M (=SO4) + CSMSAM (=MSA)
+     sssupco(:,:)      =   tr_seri(:,:,id_SSSSM)                         *zrho(:,:)*1.e9  ! SSSSM
+     sscoarse(:,:)     =   tr_seri(:,:,id_CSSSM)                         *zrho(:,:)*1.e9  ! CSSSM
+     ssacu(:,:)        =   tr_seri(:,:,id_ASSSM)                         *zrho(:,:)*1.e9  ! ASSSM
+     cidust(:,:)       =   tr_seri(:,:,id_CIDUSTM)                       *zrho(:,:)*1.e9  ! CIDUSTM
+     bcins(:,:)        =   tr_seri(:,:,id_AIBCM)                         *zrho(:,:)*1.e9  ! AIBCM
+     pomins(:,:)       =   tr_seri(:,:,id_AIPOMM)                        *zrho(:,:)*1.e9  ! AIPOMM
+     nitracc(:,:)      =   tr_seri(:,:,id_ASNO3M)                        *zrho(:,:)*1.e9  ! ASNO3M
+     nitrcoarse(:,:)   =   tr_seri(:,:,id_CSNO3M)                        *zrho(:,:)*1.e9  ! CSNO3M
+     nitrinscoarse(:,:)=   tr_seri(:,:,id_CINO3M)                        *zrho(:,:)*1.e9  ! CINO3M
+     !
+     bcsol_pi(:,:)        =   0.0 ! ASBCM pre-ind
+     pomsol_pi(:,:)       =   0.0 ! ASPOMM pre-ind
+     sulfacc_pi(:,:)      =   0.0 ! ASSO4M (=SO4) + ASMSAM (=MSA) pre-ind
+     sulfcoarse_pi(:,:)   =   0.0 ! CSSO4M (=SO4) + CSMSAM (=MSA) pre-ind
+     sssupco_pi(:,:)      =   0.0 ! SSSSM pre-ind
+     sscoarse_pi(:,:)     =   0.0 ! CSSSM pre-ind
+     ssacu_pi(:,:)        =   0.0 ! ASSSM pre-ind
+     cidust_pi(:,:)       =   0.0 ! CIDUSTM pre-ind
+     bcins_pi(:,:)        =   0.0 ! AIBCM pre-ind
+     pomins_pi(:,:)       =   0.0 ! AIPOMM pre-ind
+     nitracc_pi(:,:)      =   0.0 ! ASNO3M pre-ind
+     nitrcoarse_pi(:,:)   =   0.0 ! CSNO3M pre-ind
+     nitrinscoarse_pi(:,:)=   0.0 ! CINO3M
+     !
+  ELSE !--not aerosol_couple
+     !
+     ! Read and interpolate sulfate
+     IF ( flag_aerosol .EQ. 1 .OR. flag_aerosol .EQ. 6 .OR. flag_aerosol .EQ. 7 ) THEN 
+
+        CALL readaerosol_interp(id_ASSO4M_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sulfacc, sulfacc_pi,loadso4)
+     ELSE
+        sulfacc(:,:) = 0. ; sulfacc_pi(:,:) = 0.
+        loadso4=0.
+     ENDIF
+
+     ! Read and interpolate bcsol and bcins
+     IF ( flag_aerosol .EQ. 2 .OR. flag_aerosol .EQ. 6 .OR. flag_aerosol .EQ. 7 ) THEN 
+
+        ! Get bc aerosol distribution 
+        CALL readaerosol_interp(id_ASBCM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcsol, bcsol_pi, load_tmp1 )
+        CALL readaerosol_interp(id_AIBCM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcins, bcins_pi, load_tmp2 )
+        loadbc(:)=load_tmp1(:)+load_tmp2(:)
+     ELSE
+        bcsol(:,:) = 0. ; bcsol_pi(:,:) = 0.
+        bcins(:,:) = 0. ; bcins_pi(:,:) = 0.
+        loadbc=0.
+     ENDIF
+
+     ! Read and interpolate pomsol and pomins
+     IF ( flag_aerosol .EQ. 3 .OR. flag_aerosol .EQ. 6 .OR. flag_aerosol .EQ. 7 ) THEN
+
+        CALL readaerosol_interp(id_ASPOMM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomsol, pomsol_pi, load_tmp3)
+        CALL readaerosol_interp(id_AIPOMM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomins, pomins_pi, load_tmp4)
+        loadoa(:)=load_tmp3(:)+load_tmp4(:)
+     ELSE
+        pomsol(:,:) = 0. ; pomsol_pi(:,:) = 0.
+        pomins(:,:) = 0. ; pomins_pi(:,:) = 0.
+        loadoa=0.
+     ENDIF
+
+     ! Read and interpolate csssm, ssssm, assssm
+     IF (flag_aerosol .EQ. 4 .OR. flag_aerosol .EQ. 6 .OR. flag_aerosol .EQ. 7 ) THEN 
+
+        CALL readaerosol_interp(id_SSSSM_phy ,itap, pdtphys,rjourvrai, &
+        debut, pplay, paprs, t_seri, sssupco, sssupco_pi, load_tmp5) 
+        CALL readaerosol_interp(id_CSSSM_phy ,itap, pdtphys,rjourvrai, &
+        debut, pplay, paprs, t_seri, sscoarse,sscoarse_pi, load_tmp6) 
+        CALL readaerosol_interp(id_ASSSM_phy ,itap, pdtphys,rjourvrai, &
+        debut, pplay, paprs, t_seri, ssacu, ssacu_pi, load_tmp7) 
+        loadss(:)=load_tmp5(:)+load_tmp6(:)+load_tmp7(:)
+     ELSE
+        sscoarse(:,:) = 0. ; sscoarse_pi(:,:) = 0. 
+        ssacu(:,:)    = 0. ; ssacu_pi(:,:) = 0. 
+        sssupco(:,:)  = 0. ; sssupco_pi = 0. 
+        loadss=0.
+     ENDIF
+
+     ! Read and interpolate cidustm
+     IF (flag_aerosol .EQ. 5 .OR. flag_aerosol .EQ. 6 .OR. flag_aerosol .EQ. 7 ) THEN 
+
+        CALL readaerosol_interp(id_CIDUSTM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, cidust, cidust_pi, loaddust) 
+
+     ELSE
+        cidust(:,:) = 0. ; cidust_pi(:,:) = 0. 
+        loaddust=0.
+     ENDIF
+     !
+     ! Read and interpolate asno3m, csno3m, cino3m
+     IF (flag_aerosol .EQ. 6 .OR. flag_aerosol .EQ. 7 ) THEN 
+
+        CALL readaerosol_interp(id_ASNO3M_phy, itap, pdtphys, rjourvrai, & 
+        debut, pplay, paprs, t_seri, nitracc, nitracc_pi, load_tmp8) 
+        CALL readaerosol_interp(id_CSNO3M_phy, itap, pdtphys, rjourvrai, & 
+        debut, pplay, paprs, t_seri, nitrcoarse, nitrcoarse_pi, load_tmp9) 
+        CALL readaerosol_interp(id_CINO3M_phy, itap, pdtphys, rjourvrai, & 
+        debut, pplay, paprs, t_seri, nitrinscoarse, nitrinscoarse_pi, load_tmp10) 
+        loadno3(:)=load_tmp8(:)+load_tmp9(:)+load_tmp10(:)
+
+     ELSE
+        nitracc(:,:)         =   0.0 ; nitracc_pi(:,:)      =   0.0 
+        nitrcoarse(:,:)      =   0.0 ; nitrcoarse_pi(:,:)   =   0.0
+        nitrinscoarse(:,:)   =   0.0 ; nitrinscoarse_pi(:,:)=   0.0
+        loadno3(:)=0.0
+     ENDIF
+     !
+     ! CSSO4M is set to 0 as not reliable
+     sulfcoarse(:,:)      =   0.0 ! CSSO4M (=SO4) + CSMSAM (=MSA) 
+     sulfcoarse_pi(:,:)   =   0.0 ! CSSO4M (=SO4) + CSMSAM (=MSA) pre-ind
+
+  ENDIF !--not aerosol_couple
+
+  !
+  ! Store all aerosols in one variable
+  !
+  m_allaer(:,:,id_ASBCM_phy)  = bcsol(:,:)        ! ASBCM
+  m_allaer(:,:,id_ASPOMM_phy) = pomsol(:,:)       ! ASPOMM
+  m_allaer(:,:,id_ASSO4M_phy) = sulfacc(:,:)      ! ASSO4M (= SO4) 
+  m_allaer(:,:,id_CSSO4M_phy) = sulfcoarse(:,:)   ! CSSO4M 
+  m_allaer(:,:,id_SSSSM_phy)  = sssupco(:,:)      ! SSSSM
+  m_allaer(:,:,id_CSSSM_phy)  = sscoarse(:,:)     ! CSSSM
+  m_allaer(:,:,id_ASSSM_phy)  = ssacu(:,:)        ! ASSSM
+  m_allaer(:,:,id_CIDUSTM_phy)= cidust(:,:)       ! CIDUSTM
+  m_allaer(:,:,id_AIBCM_phy)  = bcins(:,:)        ! AIBCM
+  m_allaer(:,:,id_ASNO3M_phy) = nitracc(:,:)      ! ASNO3M
+  m_allaer(:,:,id_CSNO3M_phy) = nitrcoarse(:,:)   ! CSNO3M
+  m_allaer(:,:,id_CINO3M_phy) = nitrinscoarse(:,:)! CINO3M
+  m_allaer(:,:,id_AIPOMM_phy) = pomins(:,:)       ! AIPOMM
+  m_allaer(:,:,id_STRAT_phy)  = 0.0
+
+  !RAF
+  m_allaer_pi(:,:,id_ASBCM_phy)  = bcsol_pi(:,:)        ! ASBCM pre-ind
+  m_allaer_pi(:,:,id_ASPOMM_phy) = pomsol_pi(:,:)       ! ASPOMM pre-ind
+  m_allaer_pi(:,:,id_ASSO4M_phy) = sulfacc_pi(:,:)      ! ASSO4M (= SO4) pre-ind
+  m_allaer_pi(:,:,id_CSSO4M_phy) = sulfcoarse_pi(:,:)   ! CSSO4M pre-ind
+  m_allaer_pi(:,:,id_SSSSM_phy)  = sssupco_pi(:,:)      ! SSSSM pre-ind
+  m_allaer_pi(:,:,id_CSSSM_phy)  = sscoarse_pi(:,:)     ! CSSSM pre-ind
+  m_allaer_pi(:,:,id_ASSSM_phy)  = ssacu_pi(:,:)        ! ASSSM pre-ind
+  m_allaer_pi(:,:,id_CIDUSTM_phy)= cidust_pi(:,:)       ! CIDUSTM pre-ind
+  m_allaer_pi(:,:,id_AIBCM_phy)  = bcins_pi(:,:)        ! AIBCM pre-ind
+  m_allaer_pi(:,:,id_ASNO3M_phy) = nitracc_pi(:,:)      ! ASNO3M pre-ind
+  m_allaer_pi(:,:,id_CSNO3M_phy) = nitrcoarse_pi(:,:)   ! CSNO3M pre-ind
+  m_allaer_pi(:,:,id_CINO3M_phy) = nitrinscoarse_pi(:,:)! CINO3M pre-ind
+  m_allaer_pi(:,:,id_AIPOMM_phy) = pomins_pi(:,:)       ! AIPOMM pre-ind
+  m_allaer_pi(:,:,id_STRAT_phy)  = 0.0
+
+  !
+  ! Calculate the total mass of all soluble aersosols
+  ! to be revisited for AR6
+  mass_solu_aero(:,:)    = sulfacc(:,:)    + bcsol(:,:)    + pomsol(:,:)    + nitracc(:,:)    + ssacu(:,:)
+  mass_solu_aero_pi(:,:) = sulfacc_pi(:,:) + bcsol_pi(:,:) + pomsol_pi(:,:) + nitracc_pi(:,:) + ssacu_pi(:,:)
+
+  !****************************************************************************************
+  ! 2) Calculate optical properties for the aerosols
+  !
+  !****************************************************************************************
+  DO k = 1, klev
+     DO i = 1, klon
+        pdel(i,k) = paprs(i,k) - paprs (i,k+1)
+     ENDDO
+  ENDDO
+
+!--new aerosol properties
+  ! aeropt_6bands for rrtm
+  CALL aeropt_6bands_rrtm(          &
+       pdel, m_allaer, rhcl,        & 
+       tau_aero, piz_aero, cg_aero, &
+       m_allaer_pi, flag_aerosol,   &
+       flag_bc_internal_mixture, zrho, ok_volcan ) 
+
+  ! aeropt_5wv only for validation and diagnostics
+  CALL aeropt_5wv_rrtm(              &
+       pdel, m_allaer,               &
+       rhcl, aerindex,               & 
+       flag_aerosol,                 & 
+       flag_bc_internal_mixture,     & 
+       pplay, t_seri,                &
+       tausum_aero, drytausum_aero, tau3d_aero )
+
+  !--call LW optical properties for tropospheric aerosols 
+  CALL aeropt_lw_rrtm(ok_alw, pdel, zrho, flag_aerosol, m_allaer, m_allaer_pi)
+
+  ! Diagnostics calculation for CMIP5 protocol
+  sconcso4(:)  =m_allaer(:,1,id_ASSO4M_phy)*1.e-9
+  sconcno3(:)  =(m_allaer(:,1,id_ASNO3M_phy)+m_allaer(:,1,id_CSNO3M_phy)+m_allaer(:,1,id_CINO3M_phy))*1.e-9
+  sconcoa(:)   =(m_allaer(:,1,id_ASPOMM_phy)+m_allaer(:,1,id_AIPOMM_phy))*1.e-9
+  sconcbc(:)   =(m_allaer(:,1,id_ASBCM_phy)+m_allaer(:,1,id_AIBCM_phy))*1.e-9
+  sconcss(:)   =(m_allaer(:,1,id_ASSSM_phy)+m_allaer(:,1,id_CSSSM_phy)+m_allaer(:,1,id_SSSSM_phy))*1.e-9
+  sconcdust(:) =m_allaer(:,1,id_CIDUSTM_phy)*1.e-9
+  concso4(:,:) =m_allaer(:,:,id_ASSO4M_phy)*1.e-9
+  concno3(:,:) =(m_allaer(:,:,id_ASNO3M_phy)+m_allaer(:,:,id_CSNO3M_phy)+m_allaer(:,:,id_CINO3M_phy))*1.e-9
+  concoa(:,:)  =(m_allaer(:,:,id_ASPOMM_phy)+m_allaer(:,:,id_AIPOMM_phy))*1.e-9
+  concbc(:,:)  =(m_allaer(:,:,id_ASBCM_phy)+m_allaer(:,:,id_AIBCM_phy))*1.e-9
+  concss(:,:)  =(m_allaer(:,:,id_ASSSM_phy)+m_allaer(:,:,id_CSSSM_phy)+m_allaer(:,:,id_SSSSM_phy))*1.e-9
+  concdust(:,:)=m_allaer(:,:,id_CIDUSTM_phy)*1.e-9
+
+END SUBROUTINE readaerosol_optic_rrtm
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/readaerosolstrato1_rrtm.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/readaerosolstrato1_rrtm.F90	(revision 5133)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/readaerosolstrato1_rrtm.F90	(revision 5133)
@@ -0,0 +1,258 @@
+!
+! $Id: readaerosolstrato1_rrtm.F90 2526 2016-05-26 22:13:40Z oboucher $
+!
+
+SUBROUTINE readaerosolstrato1_rrtm(debut)
+
+    USE netcdf95, ONLY: nf95_close, nf95_gw_var, nf95_inq_dimid, & 
+                        nf95_inq_varid, nf95_open
+    USE netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_nowrite
+
+    USE phys_cal_mod, ONLY : mth_cur
+    USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat, klon_glo, grid2dTo1d_glo, grid_type, unstructured
+    USE lmdz_phys_para
+    USE phys_state_var_mod
+    USE phys_local_var_mod
+    USE aero_mod
+    USE dimphy
+    USE YOERAD, ONLY : NLW
+    USE YOMCST
+    USE lmdz_xios
+
+    IMPLICIT NONE
+
+! Variable input
+    LOGICAL debut
+
+! Variables locales
+    INTEGER n_lat   ! number of latitudes in the input data
+    INTEGER n_lon   ! number of longitudes in the input data
+    INTEGER n_lev   ! number of levels in the input data
+    INTEGER n_month ! number of months in the input data
+    REAL, ALLOCATABLE:: latitude(:)
+    REAL, ALLOCATABLE:: longitude(:)
+    REAL, ALLOCATABLE:: time(:)
+    REAL, ALLOCATABLE:: lev(:)
+    INTEGER k, band, wave, i
+    INTEGER, SAVE :: mth_pre=1
+!$OMP THREADPRIVATE(mth_pre)
+
+    REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: tau_aer_strat
+!$OMP THREADPRIVATE(tau_aer_strat)
+
+! Champs reconstitues
+    REAL, ALLOCATABLE:: tauaerstrat(:, :, :, :)
+    REAL, ALLOCATABLE:: tauaerstrat_mois(:, :, :)
+    REAL, ALLOCATABLE:: tauaerstrat_mois_glo(:, :)
+    REAL, ALLOCATABLE:: tauaerstrat_mpi(:, :)
+
+! For NetCDF:
+    INTEGER ncid_in  ! IDs for input files
+    INTEGER varid, ncerr
+
+! Stratospheric aerosols optical properties
+! alpha_sw_strat over the 6 bands is normalised by the 550 nm extinction coefficient
+    REAL, DIMENSION(nbands_sw_rrtm) :: alpha_sw_strat, piz_sw_strat, cg_sw_strat
+    DATA alpha_sw_strat/0.8545564, 0.8451642, 0.9821724, 0.8145110, 0.3073565, 7.7966176E-02/
+    DATA cg_sw_strat   /0.6997170, 0.6810035, 0.7403592, 0.7562674, 0.6676504, 0.3478689/
+    DATA piz_sw_strat  /0.9999998, 0.9999998, 1.000000000, 0.9999958, 0.9977155, 0.4510679/
+!
+!--diagnostics AOD in the SW
+! alpha_sw_strat_wave is *not* normalised by the 550 nm extinction coefficient
+    REAL, DIMENSION(nwave_sw) :: alpha_sw_strat_wave
+    DATA alpha_sw_strat_wave/3.708007,4.125824,4.136584,3.887478,3.507738/
+!
+!--diagnostics AOD in the LW at 10 um (not normalised by the 550 nm ext coefficient
+    REAL :: alpha_lw_strat_wave(nwave_lw)
+    DATA alpha_lw_strat_wave/0.2746812/
+!
+    REAL, DIMENSION(nbands_lw_rrtm) :: alpha_lw_abs_rrtm
+    DATA alpha_lw_abs_rrtm/   8.8340312E-02, 6.9856711E-02, 6.2652975E-02, 5.7188231E-02, &
+                              6.3157059E-02, 5.5072524E-02, 5.0571125E-02, 0.1349073, &    
+                              0.1381676, 9.6506312E-02, 5.1312990E-02, 2.4256418E-02, &
+                              2.7191756E-02, 3.3862915E-02, 1.6132960E-02, 1.4275438E-02/ ! calculated with Mie_SW_LW_RRTM_V2.4 (bimodal, corrected)
+                                                                                          ! for r_0=/0.13E-6, 0.41E-6/ m, sigma_g=/1.26, 1.30/
+                                                                                          ! order: increasing wavelength!
+!--------------------------------------------------------
+
+    IF (.not.ALLOCATED(tau_aer_strat)) ALLOCATE(tau_aer_strat(klon,klev))
+
+!--we only read monthly strat aerosol data
+    IF (debut.OR.mth_cur.NE.mth_pre) THEN
+
+!--only root reads the data
+    IF (is_mpi_root.AND.is_omp_root) THEN
+
+    IF (nbands_sw_rrtm.NE.6) THEN 
+        print *,'nbands_sw_rrtm doit etre egal a 6 dans readaerosolstrat_rrtm'
+        STOP
+    ENDIF
+
+    CALL nf95_open("taustrat.nc", nf90_nowrite, ncid_in)
+
+    CALL nf95_inq_varid(ncid_in, "LEV", varid)
+    CALL nf95_gw_var(ncid_in, varid, lev)
+    n_lev = size(lev)
+    IF (n_lev.NE.klev) THEN 
+       print *,'Le nombre de niveaux n est pas egal a klev'
+       STOP
+    ENDIF
+
+    CALL nf95_inq_varid(ncid_in, "LAT", varid)
+    CALL nf95_gw_var(ncid_in, varid, latitude)
+    n_lat = size(latitude)
+    print *, 'LAT aerosol strato=', n_lat, latitude
+
+    IF (grid_type/=unstructured) THEN
+      IF (n_lat.NE.nbp_lat) THEN 
+         print *,'Le nombre de lat n est pas egal a nbp_lat'
+         STOP
+      ENDIF
+    ENDIF
+    
+    CALL nf95_inq_varid(ncid_in, "LON", varid)
+    CALL nf95_gw_var(ncid_in, varid, longitude)
+    n_lon = size(longitude)
+    print *, 'LON aerosol strato=', n_lon, longitude
+
+    IF (grid_type/=unstructured) THEN
+      IF (n_lon.NE.nbp_lon) THEN 
+         print *,'Le nombre de lon n est pas egal a nbp_lon'
+         STOP
+      ENDIF
+    ENDIF
+    
+    
+    CALL nf95_inq_varid(ncid_in, "TIME", varid)
+    CALL nf95_gw_var(ncid_in, varid, time)
+    n_month = size(time)
+    print *, 'TIME aerosol strato=', n_month, time
+    IF (n_month.NE.12) THEN 
+       print *,'Le nombre de month n est pas egal a 12'
+       STOP
+    ENDIF
+
+    ALLOCATE(tauaerstrat(n_lon, n_lat, n_lev, n_month))
+    ALLOCATE(tauaerstrat_mois(n_lon, n_lat, n_lev))
+    ALLOCATE(tauaerstrat_mois_glo(klon_glo, n_lev))
+
+!--reading stratospheric AOD at 550 nm
+    CALL nf95_inq_varid(ncid_in, "TAUSTRAT", varid)
+    ncerr = nf90_get_var(ncid_in, varid, tauaerstrat)
+    print *,'code erreur readaerosolstrato=', ncerr, varid
+
+    CALL nf95_close(ncid_in)
+
+!---select the correct month
+    IF (mth_cur.LT.1.OR.mth_cur.GT.12) THEN
+      print *,'probleme avec le mois dans readaerosolstrat =', mth_cur
+    ENDIF
+    tauaerstrat_mois(:,:,:) = tauaerstrat(:,:,:,mth_cur)
+
+!---reduce to a klon_glo grid 
+    CALL grid2dTo1d_glo(tauaerstrat_mois,tauaerstrat_mois_glo)
+    
+    ELSE
+      ALLOCATE(tauaerstrat_mois(0,0,0))
+    ENDIF !--is_mpi_root and is_omp_root
+
+!$OMP BARRIER
+
+!--keep memory of previous month
+    mth_pre=mth_cur
+
+!--scatter on all proc
+    
+    IF (grid_type==unstructured) THEN
+      IF (is_omp_master) THEN
+        ALLOCATE(tauaerstrat_mpi(klon_mpi,klev))
+        CALL xios_send_field("taustrat_in",tauaerstrat_mois)
+        CALL xios_recv_field("taustrat_out",tauaerstrat_mpi)
+      ELSE
+        ALLOCATE(tauaerstrat_mpi(0,0))
+      ENDIF
+      CALL scatter_omp(tauaerstrat_mpi,tau_aer_strat)
+    ELSE  
+      CALL scatter(tauaerstrat_mois_glo,tau_aer_strat)
+    ENDIF
+    
+    IF (is_mpi_root.AND.is_omp_root) THEN
+!
+    DEALLOCATE(tauaerstrat)
+    DEALLOCATE(tauaerstrat_mois)
+    DEALLOCATE(tauaerstrat_mois_glo)
+!
+    ENDIF !--is_mpi_root and is_omp_root
+
+!$OMP BARRIER
+
+    ENDIF !--debut ou nouveau mois
+
+!--total vertical aod at the 5 SW wavelengths
+    DO wave=1, nwave_sw
+    DO k=1, klev
+      tausum_aero(:,wave,id_STRAT_phy)=tausum_aero(:,wave,id_STRAT_phy)+ &
+          tau_aer_strat(:,k)*alpha_sw_strat_wave(wave)/alpha_sw_strat_wave(2)
+    ENDDO
+    ENDDO
+
+!--weighted average for cg, piz and tau, adding strat aerosols on top of tropospheric ones
+    DO band=1, nbands_sw_rrtm
+!--anthropogenic aerosols bands 1 to nbands_sw_rrtm 
+    cg_aero_sw_rrtm(:,:,2,band)  = ( cg_aero_sw_rrtm(:,:,2,band)*piz_aero_sw_rrtm(:,:,2,band)*tau_aero_sw_rrtm(:,:,2,band) + &
+                                  cg_sw_strat(band)*piz_sw_strat(band)*alpha_sw_strat(band)*tau_aer_strat(:,:) ) /           &
+                             MAX( piz_aero_sw_rrtm(:,:,2,band)*tau_aero_sw_rrtm(:,:,2,band) +                                &
+                                  piz_sw_strat(band)*alpha_sw_strat(band)*tau_aer_strat(:,:), 1.e-15 )
+    piz_aero_sw_rrtm(:,:,2,band)  = ( piz_aero_sw_rrtm(:,:,2,band)*tau_aero_sw_rrtm(:,:,2,band) +                            &
+                              piz_sw_strat(band)*alpha_sw_strat(band)*tau_aer_strat(:,:) ) /                                 &
+                              MAX( tau_aero_sw_rrtm(:,:,2,band) + alpha_sw_strat(band)*tau_aer_strat(:,:), 1.e-15 )
+    tau_aero_sw_rrtm(:,:,2,band)  = tau_aero_sw_rrtm(:,:,2,band) + alpha_sw_strat(band)*tau_aer_strat(:,:)
+!--natural aerosols bands 1 to nbands_sw_rrtm
+    cg_aero_sw_rrtm(:,:,1,band)  = ( cg_aero_sw_rrtm(:,:,1,band)*piz_aero_sw_rrtm(:,:,1,band)*tau_aero_sw_rrtm(:,:,1,band) + &
+                             cg_sw_strat(band)*piz_sw_strat(band)*alpha_sw_strat(band)*tau_aer_strat(:,:) ) /                &
+                             MAX( piz_aero_sw_rrtm(:,:,1,band)*tau_aero_sw_rrtm(:,:,1,band) +                                &
+                                  piz_sw_strat(band)*alpha_sw_strat(band)*tau_aer_strat(:,:), 1.e-15 )
+    piz_aero_sw_rrtm(:,:,1,band)  = ( piz_aero_sw_rrtm(:,:,1,band)*tau_aero_sw_rrtm(:,:,1,band) +                            &
+                              piz_sw_strat(band)*alpha_sw_strat(band)*tau_aer_strat(:,:) ) /                                 &
+                              MAX( tau_aero_sw_rrtm(:,:,1,band) + alpha_sw_strat(band)*tau_aer_strat(:,:),1.e-15 )
+    tau_aero_sw_rrtm(:,:,1,band)  = tau_aero_sw_rrtm(:,:,1,band) + alpha_sw_strat(band)*tau_aer_strat(:,:)
+!--no stratospheric aerosol in index 1 for these tests
+!    cg_aero_sw_rrtm(:,:,1,band)  =  cg_aero_sw_rrtm(:,:,1,band)
+!    piz_aero_sw_rrtm(:,:,1,band)  = piz_aero_sw_rrtm(:,:,1,band)
+!    tau_aero_sw_rrtm(:,:,1,band)  = tau_aero_sw_rrtm(:,:,1,band)
+    ENDDO
+
+!--stratospheric AOD in LW
+    IF (nbands_lw_rrtm .NE. NLW) then
+      print*, 'different values for NLW (=',NLW,') and nbands_lw_rrtm (=', nbands_lw_rrtm, ')'
+      STOP
+    ENDIF 
+
+!--total vertical aod at the 1 LW wavelength
+    DO wave=1, nwave_lw
+    DO k=1, klev
+      tausum_aero(:,nwave_sw+wave,id_STRAT_phy)=tausum_aero(:,nwave_sw+wave,id_STRAT_phy)+ &
+         tau_aer_strat(:,k)*alpha_lw_strat_wave(wave)/alpha_sw_strat_wave(2)
+    ENDDO
+    ENDDO
+
+    DO band=1, nbands_lw_rrtm
+    tau_aero_lw_rrtm(:,:,2,band)  = tau_aero_lw_rrtm(:,:,2,band) + alpha_lw_abs_rrtm(band)*tau_aer_strat(:,:)
+    tau_aero_lw_rrtm(:,:,1,band)  = tau_aero_lw_rrtm(:,:,1,band) + alpha_lw_abs_rrtm(band)*tau_aer_strat(:,:) 
+!--no stratospheric aerosols in index 1 for these tests
+!    tau_aero_lw_rrtm(:,:,1,band)  = tau_aero_lw_rrtm(:,:,1,band) 
+    ENDDO
+
+!--default SSA value if there is no aerosol
+!--to avoid 0 values that seems to cause some problem to RRTM
+    WHERE (tau_aero_sw_rrtm.LT.1.e-14)
+      piz_aero_sw_rrtm = 1.0
+    ENDWHERE
+
+!--in principle this should not be necessary 
+!--as these variables have min values already but just in case
+!--put 1e-15 min value to both SW and LW AOD
+    tau_aero_sw_rrtm = MAX(tau_aero_sw_rrtm,1.e-15)
+    tau_aero_lw_rrtm = MAX(tau_aero_lw_rrtm,1.e-15)
+
+END SUBROUTINE readaerosolstrato1_rrtm
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/readaerosolstrato2_rrtm.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/readaerosolstrato2_rrtm.F90	(revision 5133)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/readaerosolstrato2_rrtm.F90	(revision 5133)
@@ -0,0 +1,441 @@
+!
+! $Id: readaerosolstrato2_rrtm.F90 2526 2016-05-26 22:13:40Z oboucher $
+!
+SUBROUTINE readaerosolstrato2_rrtm(debut, ok_volcan)
+
+    USE netcdf95, ONLY: nf95_close, nf95_gw_var, nf95_inq_dimid, & 
+                        nf95_inq_varid, nf95_open
+    USE netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_nowrite
+
+    USE phys_cal_mod, ONLY : mth_cur
+    USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat, klon_glo, grid2dTo1d_glo, grid_type, unstructured
+    USE lmdz_phys_mpi_data
+    USE lmdz_phys_omp_data
+    USE lmdz_phys_para
+    USE phys_state_var_mod
+    USE phys_local_var_mod
+    USE aero_mod
+    USE dimphy
+    USE YOERAD, ONLY : NLW
+    USE YOMCST
+    USE lmdz_xios
+    USE lmdz_abort_physic, ONLY: abort_physic
+
+    IMPLICIT NONE
+
+    INCLUDE "clesphys.h"
+
+    CHARACTER (len = 80) :: abort_message
+    CHARACTER (LEN=20) :: modname = 'readaerosolstrato2'
+
+! Variable input
+    LOGICAL, INTENT(IN) ::  debut
+    LOGICAL, INTENT(IN) ::  ok_volcan !activate volcanic diags
+
+! Variables locales
+    INTEGER n_lat   ! number of latitudes in the input data
+    INTEGER n_lon   ! number of longitudes
+    INTEGER n_lev   ! number of levels in the input data
+    INTEGER n_month ! number of months in the input data
+    INTEGER n_wav   ! number of wavelengths in the input data
+    REAL, ALLOCATABLE:: latitude(:)
+    REAL, ALLOCATABLE:: time(:)
+    REAL, ALLOCATABLE:: lev(:)
+    REAL, ALLOCATABLE:: wav(:)
+    INTEGER i,k,wave,band
+    INTEGER, SAVE :: mth_pre=1
+!$OMP THREADPRIVATE(mth_pre)
+
+    REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: tau_aer_strat
+    REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: piz_aer_strat
+    REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cg_aer_strat
+    REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: taulw_aer_strat
+!$OMP THREADPRIVATE(tau_aer_strat,piz_aer_strat,cg_aer_strat,taulw_aer_strat)
+
+! Champs reconstitues
+    REAL, ALLOCATABLE:: tauaerstrat(:, :, :, :)
+    REAL, ALLOCATABLE:: pizaerstrat(:, :, :, :)
+    REAL, ALLOCATABLE:: cgaerstrat(:, :, :, :)
+    REAL, ALLOCATABLE:: taulwaerstrat(:, :, :, :)
+
+    REAL, ALLOCATABLE:: tauaerstrat_mois(:, :, :, :)
+    REAL, ALLOCATABLE:: pizaerstrat_mois(:, :, :, :)
+    REAL, ALLOCATABLE:: cgaerstrat_mois(:, :, :, :)
+    REAL, ALLOCATABLE:: taulwaerstrat_mois(:, :, :, :)
+
+    REAL, ALLOCATABLE:: tauaerstrat_mois_glo(:, :, :)
+    REAL, ALLOCATABLE:: pizaerstrat_mois_glo(:, :, :)
+    REAL, ALLOCATABLE:: cgaerstrat_mois_glo(:, :, :)
+    REAL, ALLOCATABLE:: taulwaerstrat_mois_glo(:, :, :)
+    REAL, ALLOCATABLE:: tauaerstrat_mpi(:, :, :)
+    REAL, ALLOCATABLE:: pizaerstrat_mpi(:, :, :)
+    REAL, ALLOCATABLE:: cgaerstrat_mpi(:, :, :)
+    REAL, ALLOCATABLE:: taulwaerstrat_mpi(:, :, :)
+
+! For NetCDF:
+    INTEGER ncid_in  ! IDs for input files
+    INTEGER varid, ncerr
+
+!--------------------------------------------------------
+
+    IF (.not.ALLOCATED(tau_aer_strat)) ALLOCATE(tau_aer_strat(klon,klev,NSW))
+    IF (.not.ALLOCATED(piz_aer_strat)) ALLOCATE(piz_aer_strat(klon,klev,NSW))
+    IF (.not.ALLOCATED(cg_aer_strat))  ALLOCATE(cg_aer_strat(klon,klev,NSW))
+
+    IF (.not.ALLOCATED(taulw_aer_strat)) ALLOCATE(taulw_aer_strat(klon,klev,NLW))
+
+!--we only read monthly strat aerosol data
+    IF (debut.OR.mth_cur.NE.mth_pre) THEN
+
+!--only root reads the data
+      IF (is_mpi_root.AND.is_omp_root) THEN
+
+!--check mth_cur
+        IF (mth_cur.LT.1.OR.mth_cur.GT.12) THEN
+          print *,'probleme avec le mois dans readaerosolstrat =', mth_cur
+        ENDIF
+
+!--initialize n_lon as input data is 2D (lat-alt) only
+        n_lon = nbp_lon
+
+!--Starts with SW optical properties
+
+        CALL nf95_open("tauswstrat.2D.nc", nf90_nowrite, ncid_in)
+
+        CALL nf95_inq_varid(ncid_in, "LEV", varid)
+        CALL nf95_gw_var(ncid_in, varid, lev)
+        n_lev = size(lev)
+        IF (n_lev.NE.klev) THEN 
+           abort_message='Le nombre de niveaux n est pas egal a klev'
+           CALL abort_physic(modname,abort_message,1)
+        ENDIF
+
+        CALL nf95_inq_varid(ncid_in, "LAT", varid)
+        CALL nf95_gw_var(ncid_in, varid, latitude)
+        n_lat = size(latitude)
+
+        IF (grid_type/=unstructured) THEN
+           IF (n_lat.NE.nbp_lat) THEN 
+             print *, 'latitude=', n_lat, nbp_lat
+             abort_message='Le nombre de lat n est pas egal a nbp_lat'
+             CALL abort_physic(modname,abort_message,1)
+           ENDIF
+        ENDIF
+
+        CALL nf95_inq_varid(ncid_in, "TIME", varid)
+        CALL nf95_gw_var(ncid_in, varid, time)
+        n_month = size(time)
+        IF (n_month.NE.12) THEN 
+           abort_message='Le nombre de month n est pas egal a 12'
+           CALL abort_physic(modname,abort_message,1)
+        ENDIF
+
+        CALL nf95_inq_varid(ncid_in, "WAV", varid)
+        CALL nf95_gw_var(ncid_in, varid, wav)
+        n_wav = size(wav)
+        print *, 'WAV aerosol strato=', n_wav, wav
+        IF (n_wav.NE.NSW) THEN 
+           abort_message='Le nombre de wav n est pas egal a NSW'
+           CALL abort_physic(modname,abort_message,1)
+        ENDIF
+
+        ALLOCATE(tauaerstrat(n_lat, n_lev, n_wav, n_month))
+        ALLOCATE(pizaerstrat(n_lat, n_lev, n_wav, n_month))
+        ALLOCATE(cgaerstrat(n_lat, n_lev, n_wav, n_month))
+
+!--reading stratospheric aerosol tau per layer
+        CALL nf95_inq_varid(ncid_in, "TAU_SUN", varid)
+        ncerr = nf90_get_var(ncid_in, varid, tauaerstrat)
+        print *,'code erreur readaerosolstrato=', ncerr, varid
+
+!--reading stratospheric aerosol omega per layer
+        CALL nf95_inq_varid(ncid_in, "OME_SUN", varid)
+        ncerr = nf90_get_var(ncid_in, varid, pizaerstrat)
+        print *,'code erreur readaerosolstrato=', ncerr, varid
+
+!--reading stratospheric aerosol g per layer
+        CALL nf95_inq_varid(ncid_in, "GGG_SUN", varid)
+        ncerr = nf90_get_var(ncid_in, varid, cgaerstrat)
+        print *,'code erreur readaerosolstrato sw=', ncerr, varid
+
+        CALL nf95_close(ncid_in)
+
+       
+        IF (grid_type/=unstructured) THEN
+          ALLOCATE(tauaerstrat_mois(n_lon, n_lat, n_lev, n_wav))
+          ALLOCATE(pizaerstrat_mois(n_lon, n_lat, n_lev, n_wav))
+          ALLOCATE(cgaerstrat_mois(n_lon, n_lat, n_lev, n_wav))
+
+          ALLOCATE(tauaerstrat_mois_glo(klon_glo, n_lev, n_wav))
+          ALLOCATE(pizaerstrat_mois_glo(klon_glo, n_lev, n_wav))
+          ALLOCATE(cgaerstrat_mois_glo(klon_glo, n_lev, n_wav))
+!--select the correct month
+!--and copy into 1st longitude
+          tauaerstrat_mois(1,:,:,:) = tauaerstrat(:,:,:,mth_cur)
+          pizaerstrat_mois(1,:,:,:) = pizaerstrat(:,:,:,mth_cur)
+          cgaerstrat_mois(1,:,:,:)  = cgaerstrat(:,:,:,mth_cur)
+
+!--copy longitudes
+          DO i=2, n_lon
+           tauaerstrat_mois(i,:,:,:) = tauaerstrat_mois(1,:,:,:)
+           pizaerstrat_mois(i,:,:,:) = pizaerstrat_mois(1,:,:,:)
+           cgaerstrat_mois(i,:,:,:)  = cgaerstrat_mois(1,:,:,:)
+          ENDDO
+
+!---reduce to a klon_glo grid 
+          DO band=1, NSW
+            CALL grid2dTo1d_glo(tauaerstrat_mois(:,:,:,band),tauaerstrat_mois_glo(:,:,band))
+            CALL grid2dTo1d_glo(pizaerstrat_mois(:,:,:,band),pizaerstrat_mois_glo(:,:,band))
+            CALL grid2dTo1d_glo(cgaerstrat_mois(:,:,:,band),cgaerstrat_mois_glo(:,:,band))
+          ENDDO
+        ENDIF
+!--Now LW optical properties
+!
+
+        CALL nf95_open("taulwstrat.2D.nc", nf90_nowrite, ncid_in)
+
+        CALL nf95_inq_varid(ncid_in, "LEV", varid)
+        CALL nf95_gw_var(ncid_in, varid, lev)
+        n_lev = size(lev)
+        IF (n_lev.NE.klev) THEN 
+           abort_message='Le nombre de niveaux n est pas egal a klev'
+           CALL abort_physic(modname,abort_message,1)
+        ENDIF
+
+        CALL nf95_inq_varid(ncid_in, "LAT", varid)
+        CALL nf95_gw_var(ncid_in, varid, latitude)
+        n_lat = size(latitude)
+
+        IF (grid_type/=unstructured) THEN
+          IF (n_lat.NE.nbp_lat) THEN 
+             abort_message='Le nombre de lat n est pas egal a nbp_lat'
+             CALL abort_physic(modname,abort_message,1)
+          ENDIF
+        ENDIF
+        
+        CALL nf95_inq_varid(ncid_in, "TIME", varid)
+        CALL nf95_gw_var(ncid_in, varid, time)
+        n_month = size(time)
+        IF (n_month.NE.12) THEN 
+           abort_message='Le nombre de month n est pas egal a 12'
+           CALL abort_physic(modname,abort_message,1)
+        ENDIF
+
+        CALL nf95_inq_varid(ncid_in, "WAV", varid)
+        CALL nf95_gw_var(ncid_in, varid, wav)
+        n_wav = size(wav)
+        print *, 'WAV aerosol strato=', n_wav, wav
+        IF (n_wav.NE.NLW) THEN 
+           abort_message='Le nombre de wav n est pas egal a NLW'
+           CALL abort_physic(modname,abort_message,1)
+        ENDIF
+
+        ALLOCATE(taulwaerstrat(n_lat, n_lev, n_wav, n_month))
+
+!--reading stratospheric aerosol lw tau per layer
+        CALL nf95_inq_varid(ncid_in, "TAU_EAR", varid)
+        ncerr = nf90_get_var(ncid_in, varid, taulwaerstrat)
+        print *,'code erreur readaerosolstrato lw=', ncerr, varid
+
+        CALL nf95_close(ncid_in)
+
+        IF (grid_type/=unstructured) THEN
+
+          ALLOCATE(taulwaerstrat_mois(n_lon, n_lat, n_lev, n_wav))
+          ALLOCATE(taulwaerstrat_mois_glo(klon_glo, n_lev, n_wav))
+
+!--select the correct month
+!--and copy into 1st longitude
+          taulwaerstrat_mois(1,:,:,:) = taulwaerstrat(:,:,:,mth_cur)
+!--copy longitudes
+          DO i=2, n_lon
+            taulwaerstrat_mois(i,:,:,:) = taulwaerstrat_mois(1,:,:,:)
+          ENDDO
+
+!---reduce to a klon_glo grid 
+          DO band=1, NLW
+            CALL grid2dTo1d_glo(taulwaerstrat_mois(:,:,:,band),taulwaerstrat_mois_glo(:,:,band))
+          ENDDO
+        ENDIF
+      
+      ELSE !--proc other than mpi_root and omp_root
+           !--dummy allocation needed for debug mode
+
+        ALLOCATE(tauaerstrat_mois_glo(1,1,1))
+        ALLOCATE(pizaerstrat_mois_glo(1,1,1))
+        ALLOCATE(cgaerstrat_mois_glo(1,1,1))
+        ALLOCATE(taulwaerstrat_mois_glo(1,1,1))
+
+        ALLOCATE(tauaerstrat(0,0,0,12))
+        ALLOCATE(pizaerstrat(0,0,0,12))
+        ALLOCATE(cgaerstrat(0,0,0,12))
+        ALLOCATE(taulwaerstrat(0,0,0,12))
+
+
+      ENDIF !--is_mpi_root and is_omp_root
+
+!$OMP BARRIER
+
+!--keep memory of previous month
+      mth_pre=mth_cur
+
+      IF (grid_type==unstructured) THEN
+
+        IF (is_omp_master) THEN
+          ALLOCATE(tauaerstrat_mpi(klon_mpi, klev, NSW))
+          ALLOCATE(pizaerstrat_mpi(klon_mpi, klev, NSW))
+          ALLOCATE(cgaerstrat_mpi(klon_mpi, klev, NSW))        
+          ALLOCATE(taulwaerstrat_mpi(klon_mpi, klev, NLW))
+         
+          CALL xios_send_field("tauaerstrat_in",SPREAD(tauaerstrat(:,:,:,mth_cur),1,8))
+          CALL xios_recv_field("tauaerstrat_out",tauaerstrat_mpi)
+          CALL xios_send_field("pizaerstrat_in",SPREAD(pizaerstrat(:,:,:,mth_cur),1,8))
+          CALL xios_recv_field("pizaerstrat_out",pizaerstrat_mpi)
+          CALL xios_send_field("cgaerstrat_in",SPREAD(cgaerstrat(:,:,:,mth_cur),1,8))
+          CALL xios_recv_field("cgaerstrat_out",cgaerstrat_mpi)
+          CALL xios_send_field("taulwaerstrat_in",SPREAD(taulwaerstrat(:,:,:,mth_cur),1,8))
+          CALL xios_recv_field("taulwaerstrat_out",taulwaerstrat_mpi)
+        ELSE
+          ALLOCATE(tauaerstrat_mpi(0, 0, 0))
+          ALLOCATE(pizaerstrat_mpi(0, 0, 0))
+          ALLOCATE(cgaerstrat_mpi(0, 0, 0))        
+          ALLOCATE(taulwaerstrat_mpi(0, 0, 0))
+        ENDIF  
+        
+        CALL scatter_omp(tauaerstrat_mpi,tau_aer_strat)
+        CALL scatter_omp(pizaerstrat_mpi,piz_aer_strat)
+        CALL scatter_omp(cgaerstrat_mpi,cg_aer_strat)
+        CALL scatter_omp(taulwaerstrat_mpi,taulw_aer_strat)
+      ELSE  
+        
+!--scatter on all proc
+        CALL scatter(tauaerstrat_mois_glo,tau_aer_strat)
+        CALL scatter(pizaerstrat_mois_glo,piz_aer_strat)
+        CALL scatter(cgaerstrat_mois_glo,cg_aer_strat)
+        CALL scatter(taulwaerstrat_mois_glo,taulw_aer_strat)
+        IF (is_mpi_root.AND.is_omp_root)  DEALLOCATE(tauaerstrat_mois, pizaerstrat_mois, cgaerstrat_mois, taulwaerstrat_mois)
+
+      ENDIF 
+
+      IF (is_mpi_root.AND.is_omp_root) THEN
+        DEALLOCATE(tauaerstrat, pizaerstrat, cgaerstrat,taulwaerstrat)
+      ENDIF
+      
+
+!$OMP BARRIER
+
+    ENDIF !--debut ou nouveau mois
+
+!--total vertical aod at the 5 SW wavelengths
+!--for now use band 3 AOD into all 5 wavelengths
+!--it is only a reasonable approximation for 550 nm (wave=2)
+    band=3
+    DO i=1, klon
+    DO k=1, klev
+      IF (stratomask(i,k).GT.0.999999) THEN
+        DO wave=1, nwave_sw
+          tausum_aero(i,wave,id_STRAT_phy)=tausum_aero(i,wave,id_STRAT_phy)+tau_aer_strat(i,k,band)
+        ENDDO
+      ENDIF
+    ENDDO
+    ENDDO
+
+    IF (.NOT. ok_volcan) THEN
+!
+!--this is the default case 
+!--stratospheric aerosols are added to both index 2 and 1 for double radiation calls
+!--weighted average for cg, piz and tau, adding strat aerosols on top of tropospheric ones
+    DO band=1, NSW
+      WHERE (stratomask.GT.0.999999)
+!--strat aerosols are added to index 2 : natural and anthropogenic aerosols for bands 1 to NSW 
+        cg_aero_sw_rrtm(:,:,2,band)  = ( cg_aero_sw_rrtm(:,:,2,band)*piz_aero_sw_rrtm(:,:,2,band)*tau_aero_sw_rrtm(:,:,2,band) + &
+                                         cg_aer_strat(:,:,band)*piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band) ) /              &
+                                    MAX( piz_aero_sw_rrtm(:,:,2,band)*tau_aero_sw_rrtm(:,:,2,band) +                             &
+                                         piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band), 1.e-15 )
+        piz_aero_sw_rrtm(:,:,2,band) = ( piz_aero_sw_rrtm(:,:,2,band)*tau_aero_sw_rrtm(:,:,2,band) +                             &
+                                         piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band) ) /                                     &
+                                    MAX( tau_aero_sw_rrtm(:,:,2,band) + tau_aer_strat(:,:,band), 1.e-15 )
+        tau_aero_sw_rrtm(:,:,2,band)  = tau_aero_sw_rrtm(:,:,2,band) + tau_aer_strat(:,:,band)
+!--strat aerosols are added to index 1 : natural aerosols only for bands 1 to NSW
+        cg_aero_sw_rrtm(:,:,1,band)  = ( cg_aero_sw_rrtm(:,:,1,band)*piz_aero_sw_rrtm(:,:,1,band)*tau_aero_sw_rrtm(:,:,1,band) + &
+                cg_aer_strat(:,:,band)*piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band) ) /              &
+                MAX( piz_aero_sw_rrtm(:,:,1,band)*tau_aero_sw_rrtm(:,:,1,band) +                             &
+                piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band), 1.e-15 )
+        piz_aero_sw_rrtm(:,:,1,band) = ( piz_aero_sw_rrtm(:,:,1,band)*tau_aero_sw_rrtm(:,:,1,band) +                             &
+                piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band) ) /                                     &
+                MAX( tau_aero_sw_rrtm(:,:,1,band) + tau_aer_strat(:,:,band), 1.e-15 )
+        tau_aero_sw_rrtm(:,:,1,band)  = tau_aero_sw_rrtm(:,:,1,band) + tau_aer_strat(:,:,band)
+    ENDWHERE
+    ENDDO
+!
+    ELSE
+!
+!--this is the VOLMIP case
+!--stratospheric aerosols are only added to index 2 in this case 
+!--weighted average for cg, piz and tau, adding strat aerosols on top of tropospheric ones
+    DO band=1, NSW
+      WHERE (stratomask.GT.0.999999)
+!--strat aerosols are added to index 2 : natural and anthropogenic aerosols for bands 1 to NSW 
+        cg_aero_sw_rrtm(:,:,2,band)  = ( cg_aero_sw_rrtm(:,:,2,band)*piz_aero_sw_rrtm(:,:,2,band)*tau_aero_sw_rrtm(:,:,2,band) + &
+                                         cg_aer_strat(:,:,band)*piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band) ) /              &
+                                    MAX( piz_aero_sw_rrtm(:,:,2,band)*tau_aero_sw_rrtm(:,:,2,band) +                             &
+                                         piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band), 1.e-15 )
+        piz_aero_sw_rrtm(:,:,2,band) = ( piz_aero_sw_rrtm(:,:,2,band)*tau_aero_sw_rrtm(:,:,2,band) +                             &
+                                         piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band) ) /                                     &
+                                    MAX( tau_aero_sw_rrtm(:,:,2,band) + tau_aer_strat(:,:,band), 1.e-15 )
+        tau_aero_sw_rrtm(:,:,2,band)  = tau_aero_sw_rrtm(:,:,2,band) + tau_aer_strat(:,:,band)
+     ENDWHERE
+  ENDDO
+  ENDIF
+
+!--total vertical aod at 10 um
+!--this is approximated from band 7 of RRTM
+    band=7
+    DO i=1, klon
+    DO k=1, klev
+      IF (stratomask(i,k).GT.0.999999) THEN
+        DO wave=1, nwave_lw
+          tausum_aero(i,nwave_sw+wave,id_STRAT_phy)=tausum_aero(i,nwave_sw+wave,id_STRAT_phy)+taulw_aer_strat(i,k,band)
+        ENDDO
+      ENDIF
+    ENDDO
+    ENDDO
+
+    IF (.NOT. ok_volcan) THEN
+!--this is the default case 
+!--stratospheric aerosols are added to both index 2 and 1
+    DO band=1, NLW
+      WHERE (stratomask.GT.0.999999)
+        tau_aero_lw_rrtm(:,:,2,band)  = tau_aero_lw_rrtm(:,:,2,band) + taulw_aer_strat(:,:,band)
+        tau_aero_lw_rrtm(:,:,1,band)  = tau_aero_lw_rrtm(:,:,1,band) + taulw_aer_strat(:,:,band)
+      ENDWHERE
+    ENDDO
+!
+    ELSE
+!
+!--this is the VOLMIP case
+    DO band=1, NLW
+!--stratospheric aerosols are not added to index 1 
+!--and we copy index 2 in index 1 because we want the same dust aerosol LW properties as above
+      tau_aero_lw_rrtm(:,:,1,band)  = tau_aero_lw_rrtm(:,:,2,band)
+!
+      WHERE (stratomask.GT.0.999999)
+!--stratospheric aerosols are only added to index 2
+        tau_aero_lw_rrtm(:,:,2,band)  = tau_aero_lw_rrtm(:,:,2,band) + taulw_aer_strat(:,:,band)
+      ENDWHERE
+    ENDDO
+    ENDIF
+
+!--default SSA value if there is no aerosol
+!--to avoid 0 values that seems to cause some problem to RRTM
+    WHERE (tau_aero_sw_rrtm.LT.1.e-14)
+      piz_aero_sw_rrtm = 1.0
+    ENDWHERE
+
+!--in principle this should not be necessary 
+!--as these variables have min values already but just in case
+!--put 1e-15 min value to both SW and LW AOD
+    tau_aero_sw_rrtm = MAX(tau_aero_sw_rrtm,1.e-15)
+    tau_aero_lw_rrtm = MAX(tau_aero_lw_rrtm,1.e-15)
+
+END SUBROUTINE readaerosolstrato2_rrtm
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/recmwf_aero.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/recmwf_aero.F90	(revision 5133)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/recmwf_aero.F90	(revision 5133)
@@ -0,0 +1,1011 @@
+!
+! $Id: recmwf_aero.F90 4875 2024-03-26 10:29:06Z lguez $
+!
+!OPTIONS XOPT(NOEVAL)
+SUBROUTINE RECMWF_AERO (KST, KEND, KPROMA, KTDIA , KLEV,&
+     & KMODE,&
+     & PALBD , PALBP , PAPRS , PAPRSF , PCCO2 , PCLFR,&
+     & PQO3  , PAER  , PDP   , PEMIS  , PMU0,&
+     & PQ    , PQS   , PQIWP , PQLWP , PSLM   , PT    , PTS,&
+     & PREF_LIQ, PREF_ICE,&
+     !--OB
+     & PREF_LIQ_PI, PREF_ICE_PI,&
+     !--fin
+     & PEMTD , PEMTU , PTRSO,&
+     & PTH   , PCTRSO, PCEMTR, PTRSOD,&
+     & PLWFC, PLWFT, PSWFC, PSWFT, PSFSWDIR, PSFSWDIF,&
+     & PFSDNN, PFSDNV,&  
+     & PPIZA_TOT,PCGA_TOT,PTAU_TOT, & 
+     !--OB
+     & PPIZA_NAT,PCGA_NAT,PTAU_NAT, & 
+     !--fin OB 
+     !--C.Kleinschmitt
+     & PTAU_LW_TOT, PTAU_LW_NAT, & 
+     !--end
+     & PFLUX,PFLUC,&
+     & PFSDN ,PFSUP , PFSCDN , PFSCUP, PFSCCDN, PFSCCUP, PFLCCDN, PFLCCUP,&
+     !--OB diagnostics
+     & PTOPSWADAERO,PSOLSWADAERO,&
+     & PTOPSWAD0AERO,PSOLSWAD0AERO,&
+     & PTOPSWAIAERO,PSOLSWAIAERO,&
+     & PTOPSWCFAERO,PSOLSWCFAERO,&
+     & PSWADAERO,& !--NL
+     !--LW diagnostics CK
+     & PTOPLWADAERO,PSOLLWADAERO,&
+     & PTOPLWAD0AERO,PSOLLWAD0AERO,&
+     & PTOPLWAIAERO,PSOLLWAIAERO,&
+     & PLWADAERO,& !--NL
+     !--ajout volmip 
+     & volmip_solsw, flag_volc_surfstrat,&
+     !..end
+     & ok_ade, ok_aie, ok_volcan, flag_aerosol,flag_aerosol_strat,&
+     & flag_aer_feedback)
+  !--fin
+
+  !**** *RECMWF* - METEO-FRANCE RADIATION INTERFACE TO ECMWF RADIATION SCHEME
+
+  !     PURPOSE.
+  !     --------
+  !           SIMPLE INTERFACE TO RADLSW (NO INTERPOLATION)
+
+  !**   INTERFACE.
+  !     ----------
+
+  !     EXPLICIT ARGUMENTS :
+  !        --------------------
+  ! KST    : START INDEX OF DATA IN KPROMA-LONG VECTOR
+  ! KEND   : END   INDEX OF DATA IN KPROMA-LONG VECTOR
+  ! KPROMA : VECTOR LENGTH
+  ! KTDIA  : INDEX OF TOP LEVEL FROM WHICH COMPUTATIONS ARE ACTIVE
+  ! KLEV   : NUMBER OF LEVELS
+  ! PAER   : (KPROMA,KLEV ,6)     ; OPTICAL THICKNESS OF THE AEROSOLS
+  ! PALBD  : (KPROMA,NSW)         ; DIFFUSE ALBEDO IN THE 2 SW INTERVALS
+  ! PALBP  : (KPROMA,NSW)         ; PARALLEL ALBEDO IN THE 2 SW INTERVALS
+  ! PAPRS  : (KPROMA,KLEV+1)      ; HALF LEVEL PRESSURE
+  ! PAPRSF : (KPROMA,KLEV )       ; FULL LEVEL PRESSURE
+  ! PCCO2  :                      ; CONCENTRATION IN CO2 (PA/PA)
+  ! PCLFR  : (KPROMA,KLEV )       ; CLOUD FRACTIONAL COVER
+  ! PQO3   : (KPROMA,KLEV )       ; OZONE MIXING RATIO (MASS)
+  ! PDP    : (KPROMA,KLEV)        ; LAYER PRESSURE THICKNESS
+  ! PEMIS  : (KPROMA)             ; SURFACE EMISSIVITY
+  ! PMU0   : (KPROMA)             ; SOLAR ANGLE
+  ! PQ     : (KPROMA,KLEV )       ; SPECIFIC HUMIDITY PA/PA
+  ! PQS    : (KPROMA,KLEV )       ; SATURATION SPECIFIC HUMIDITY PA/PA
+  ! PQIWP  : (KPROMA,KLEV )       ; ICE    WATER KG/KG
+  ! PQLWP  : (KPROMA,KLEV )       ; LIQUID WATER KG/KG
+  ! PSLM   : (KPROMA)             ; LAND-SEA MASK
+  ! PT     : (KPROMA,KLEV)        ; FULL LEVEL TEMPERATURE
+  ! PTS    : (KPROMA)             ; SURFACE TEMPERATURE
+  ! PPIZA_TOT  : (KPROMA,KLEV,NSW); Single scattering albedo of total aerosol
+  ! PCGA_TOT   : (KPROMA,KLEV,NSW); Assymetry factor for total aerosol
+  ! PTAU_TOT: (KPROMA,KLEV,NSW)   ; Optical depth of total aerosol
+  ! PREF_LIQ (KPROMA,KLEV)        ; Liquid droplet radius (um) - present-day
+  ! PREF_ICE (KPROMA,KLEV)        ; Ice crystal radius (um) - present-day
+  !--OB
+  ! PREF_LIQ_PI (KPROMA,KLEV)     ; Liquid droplet radius (um) - pre-industrial 
+  ! PREF_ICE_PI (KPROMA,KLEV)     ; Ice crystal radius (um) - pre-industrial 
+  ! ok_ade---input-L- apply the Aerosol Direct Effect or not?
+  ! ok_aie---input-L- apply the Aerosol Indirect Effect or not?
+  ! ok_volcan-input-L- activate volcanic diags (SW heat & LW cool rate, SW & LW flux)
+  ! flag_aerosol-input-I- aerosol flag from 0 to 7
+  ! flag_aerosol_strat-input-I- use stratospheric aerosols flag (T/F)
+  ! flag_aer_feedback-input-I- use aerosols radiative effect flag (T/F)
+  ! PPIZA_NAT  : (KPROMA,KLEV,NSW); Single scattering albedo of natural aerosol
+  ! PCGA_NAT   : (KPROMA,KLEV,NSW); Assymetry factor for natural aerosol
+  ! PTAU_NAT: (KPROMA,KLEV,NSW)   ; Optical depth of natural aerosol
+  ! PTAU_LW_TOT  (KPROMA,KLEV,NLW); LW Optical depth of total aerosols  
+  ! PTAU_LW_NAT  (KPROMA,KLEV,NLW); LW Optical depth of natural aerosols 
+  !--fin OB
+
+  !     ==== OUTPUTS ===
+  ! PEMTD (KPROMA,KLEV+1)         ; TOTAL DOWNWARD LONGWAVE EMISSIVITY
+  ! PEMTU (KPROMA,KLEV+1)         ; TOTAL UPWARD   LONGWAVE EMISSIVITY
+  ! PTRSO (KPROMA,KLEV+1)         ; TOTAL SHORTWAVE TRANSMISSIVITY
+  ! PTH   (KPROMA,KLEV+1)         ; HALF LEVEL TEMPERATURE
+  ! PCTRSO(KPROMA,2)              ; CLEAR-SKY SHORTWAVE TRANSMISSIVITY
+  ! PCEMTR(KPROMA,2)              ; CLEAR-SKY NET LONGWAVE EMISSIVITY
+  ! PTRSOD(KPROMA)                ; TOTAL-SKY SURFACE SW TRANSMISSITY
+  ! PLWFC (KPROMA,2)              ; CLEAR-SKY LONGWAVE FLUXES
+  ! PLWFT (KPROMA,KLEV+1)         ; TOTAL-SKY LONGWAVE FLUXES
+  ! PSWFC (KPROMA,2)              ; CLEAR-SKY SHORTWAVE FLUXES
+  ! PSWFT (KPROMA,KLEV+1)         ; TOTAL-SKY SHORTWAVE FLUXES
+  ! Ajout flux LW et SW montants et descendants, et ciel clair (MPL 19.12.08)
+  ! PFLUX (KPROMA,2,KLEV+1)       ; LW total sky flux (1=up, 2=down)
+  ! PFLUC (KPROMA,2,KLEV+1)       ; LW clear sky flux (1=up, 2=down)
+  ! PFSDN(KPROMA,KLEV+1)          ; SW total sky flux down
+  ! PFSUP(KPROMA,KLEV+1)          ; SW total sky flux up
+  ! PFSCDN(KPROMA,KLEV+1)         ; SW clear sky flux down
+  ! PFSCUP(KPROMA,KLEV+1)         ; SW clear sky flux up
+  ! PFSCCDN(KPROMA,KLEV+1)        ; SW clear sky clean (no aerosol) flux down
+  ! PFSCCUP(KPROMA,KLEV+1)        ; SW clear sky clean (no aerosol) flux up
+  ! PFLCCDN(KPROMA,KLEV+1)        ; LW clear sky clean (no aerosol) flux down
+  ! PFLCCUP(KPROMA,KLEV+1)        ; LW clear sky clean (no aerosol) flux up
+
+
+  !        IMPLICIT ARGUMENTS :   NONE
+  !        --------------------
+
+  !     METHOD.
+  !     -------
+  !     SEE DOCUMENTATION
+
+  !     EXTERNALS.
+  !     ----------
+
+  !     REFERENCE.
+  !     ----------
+  !     ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
+
+  !     AUTHORS.
+  !     --------
+  !     ORIGINAL BY  B. RITTER   *ECMWF*        83-10-13
+  !     REWRITING FOR IFS BY J.-J. MORCRETTE    94-11-15
+  !     96-11: Ph. Dandin. Meteo-France
+  !     REWRITING FOR DM  BY J.PH. PIEDELIEVRE   1998-07
+  !     Duplication of RFMR to use present (cy25) ECMWF radiation scheme : Y. Bouteloup 09-2003
+  !     Use of 6 aerosols & introduce NSW : F. Bouyssel 09-2004
+  !     04-11-18 : 4 New arguments for AROME : Y. Seity 
+  !     2005-10-10 Y. Seity : 3 optional arguments for dust optical properties 
+  !     JJMorcrette 20060721 PP of clear-sky PAR and TOA incident solar radiation (ECMWF)
+  !     Olivier Boucher: added LMD radiation diagnostics 2014-03
+
+  !-----------------------------------------------------------------------
+
+  USE PARKIND1  ,ONLY : JPIM     ,JPRB
+  USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+  USE YOEAERD  , ONLY : RCAEROS
+  USE YOMCST   , ONLY :         RMD      ,RMO3
+  USE YOMPHY3  , ONLY : RII0
+  USE YOERAD   , ONLY : NLW, NAER, RCCNLND  ,RCCNSEA  
+  USE YOERAD   , ONLY : NAER, RCCNLND  ,RCCNSEA  
+  USE YOERDU   , ONLY : REPSCQ
+  USE YOMGEM   , ONLY : NGPTOT
+  USE YOERDI   , ONLY : RRAE   ,REPCLC    ,REPH2O
+  USE YOMARPHY , ONLY : LRDUST 
+  USE phys_output_mod, ONLY : swaerofree_diag, swaero_diag
+
+  !-----------------------------------------------------------------------
+
+  !*       0.1   ARGUMENTS.
+  !              ----------
+
+  IMPLICIT NONE
+  INCLUDE "clesphys.h"
+
+  INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMA 
+  INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
+  INTEGER(KIND=JPIM),INTENT(IN)    :: KST 
+  INTEGER(KIND=JPIM),INTENT(IN)    :: KEND 
+  INTEGER(KIND=JPIM)               :: KTDIA ! Argument NOT used
+  INTEGER(KIND=JPIM),INTENT(IN)    :: KMODE
+  REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBD(KPROMA,NSW) 
+  REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBP(KPROMA,NSW) 
+  REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPRS(KPROMA,KLEV+1)
+  REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPRSF(KPROMA,KLEV) 
+  REAL(KIND=JPRB)   ,INTENT(IN)    :: PCCO2
+  REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLFR(KPROMA,KLEV) 
+  REAL(KIND=JPRB)   ,INTENT(IN)    :: PQO3(KPROMA,KLEV) 
+  REAL(KIND=JPRB)   ,INTENT(IN)    :: PAER(KPROMA,KLEV,6) 
+  REAL(KIND=JPRB)   ,INTENT(IN)    :: PDP(KPROMA,KLEV) 
+  REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIS(KPROMA) 
+  REAL(KIND=JPRB)   ,INTENT(IN)    :: PMU0(KPROMA) 
+  REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ(KPROMA,KLEV) 
+  REAL(KIND=JPRB)   ,INTENT(IN)    :: PQS(KPROMA,KLEV)
+  REAL(KIND=JPRB)   ,INTENT(IN)    :: PQIWP(KPROMA,KLEV) 
+  REAL(KIND=JPRB)   ,INTENT(IN)    :: PQLWP(KPROMA,KLEV) 
+  REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLM(KPROMA)
+  REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KPROMA,KLEV) 
+  REAL(KIND=JPRB)   ,INTENT(IN)    :: PTS(KPROMA)
+  REAL(KIND=JPRB)   ,INTENT(IN)    :: PPIZA_TOT(KPROMA,KLEV,NSW)
+  REAL(KIND=JPRB)   ,INTENT(IN)    :: PCGA_TOT(KPROMA,KLEV,NSW)
+  REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAU_TOT(KPROMA,KLEV,NSW)
+  !--OB
+  REAL(KIND=JPRB)   ,INTENT(IN)    :: PPIZA_NAT(KPROMA,KLEV,NSW)
+  REAL(KIND=JPRB)   ,INTENT(IN)    :: PCGA_NAT(KPROMA,KLEV,NSW)
+  REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAU_NAT(KPROMA,KLEV,NSW)
+  REAL(KIND=JPRB)                  :: PPIZA_ZERO(KPROMA,KLEV,NSW)
+  REAL(KIND=JPRB)                  :: PCGA_ZERO(KPROMA,KLEV,NSW)
+  REAL(KIND=JPRB)                  :: PTAU_ZERO(KPROMA,KLEV,NSW)
+  !--fin
+  !--C.Kleinschmitt
+  REAL(KIND=JPRB)                  :: PTAU_LW_ZERO(KPROMA,KLEV,NLW)
+  REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAU_LW_TOT(KPROMA,KLEV,NLW)
+  REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAU_LW_NAT(KPROMA,KLEV,NLW)
+  !--end
+  REAL(KIND=JPRB)   ,INTENT(IN)    :: PREF_LIQ(KPROMA,KLEV)
+  REAL(KIND=JPRB)   ,INTENT(IN)    :: PREF_ICE(KPROMA,KLEV)
+  !--OB
+  REAL(KIND=JPRB)   ,INTENT(IN)    :: PREF_LIQ_PI(KPROMA,KLEV)
+  REAL(KIND=JPRB)   ,INTENT(IN)    :: PREF_ICE_PI(KPROMA,KLEV)
+  LOGICAL, INTENT(in)  :: ok_ade, ok_aie         ! switches whether to use aerosol direct (indirect) effects or not
+  LOGICAL, INTENT(in)  :: ok_volcan              ! produce volcanic diags (SW/LW heat flux and rate)
+  INTEGER, INTENT(in)  :: flag_aerosol           ! takes value 0 (no aerosol) or 1 to 6 (aerosols)
+  LOGICAL, INTENT(in)  :: flag_aerosol_strat     ! use stratospheric aerosols
+  LOGICAL, INTENT(in)  :: flag_aer_feedback      ! use aerosols radiative feedback
+  REAL(KIND=JPRB)   ,INTENT(out)   :: PTOPSWADAERO(KPROMA), PSOLSWADAERO(KPROMA)       ! Aerosol direct forcing at TOA and surface
+  REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTOPSWAD0AERO(KPROMA), PSOLSWAD0AERO(KPROMA)     ! Aerosol direct forcing at TOA and surface
+  REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTOPSWAIAERO(KPROMA), PSOLSWAIAERO(KPROMA)       ! ditto, indirect
+  REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTOPSWCFAERO(KPROMA,3), PSOLSWCFAERO(KPROMA,3) !--do we keep this ?
+  !--fin
+  !--NL
+  REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSWADAERO(KPROMA, KLEV+1)                        ! SW Aerosol direct forcing
+  REAL(KIND=JPRB)   ,INTENT(OUT)   :: PLWADAERO(KPROMA, KLEV+1)                        ! LW Aerosol direct forcing
+  !--CK
+  REAL(KIND=JPRB)   ,INTENT(out)   :: PTOPLWADAERO(KPROMA), PSOLLWADAERO(KPROMA)       ! LW Aerosol direct forcing at TOA + surface
+  REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTOPLWAD0AERO(KPROMA), PSOLLWAD0AERO(KPROMA)     ! LW Aerosol direct forcing at TOA + surface
+  REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTOPLWAIAERO(KPROMA), PSOLLWAIAERO(KPROMA)       ! LW Aer. indirect forcing at TOA + surface
+  !--end
+  REAL(KIND=JPRB)   ,INTENT(OUT)   :: PEMTD(KPROMA,KLEV+1) 
+  REAL(KIND=JPRB)   ,INTENT(OUT)   :: PEMTU(KPROMA,KLEV+1) 
+  REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTRSO(KPROMA,KLEV+1) 
+  REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTH(KPROMA,KLEV+1)
+  REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCTRSO(KPROMA,2) 
+  REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCEMTR(KPROMA,2) 
+  REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTRSOD(KPROMA) 
+  REAL(KIND=JPRB)   ,INTENT(OUT)   :: PLWFC(KPROMA,2) 
+  REAL(KIND=JPRB)   ,INTENT(OUT)   :: PLWFT(KPROMA,KLEV+1) 
+  REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSWFC(KPROMA,2) 
+  REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSWFT(KPROMA,KLEV+1) 
+  REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSFSWDIR(KPROMA,NSW)
+  REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSFSWDIF(KPROMA,NSW)
+  REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSDNN(KPROMA)
+  REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSDNV(KPROMA)
+  REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLUX(KPROMA,2,KLEV+1) ! LW total sky flux (1=up, 2=down)
+  REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLUC(KPROMA,2,KLEV+1) ! LW clear sky flux (1=up, 2=down)
+  REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSDN(KPROMA,KLEV+1)   ! SW total sky flux down
+  REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSUP(KPROMA,KLEV+1)   ! SW total sky flux up
+  REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSCDN(KPROMA,KLEV+1)  ! SW clear sky flux down
+  REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSCUP(KPROMA,KLEV+1)  ! SW clear sky flux up
+  REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSCCDN(KPROMA,KLEV+1) ! SW clear sky clean (no aerosol) flux down
+  REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSCCUP(KPROMA,KLEV+1) ! SW clear sky clean (no aerosol) flux up
+  REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLCCDN(KPROMA,KLEV+1) ! LW clear sky clean (no aerosol) flux down
+  REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLCCUP(KPROMA,KLEV+1) ! LW clear sky clean (no aerosol) flux up
+  !--ajout VOLMIP
+  REAL(KIND=JPRB)   ,INTENT(OUT)   :: volmip_solsw(KPROMA) ! SW clear sky in the case of VOLMIP
+  INTEGER, INTENT(IN)              :: flag_volc_surfstrat !--VOlMIP Modif
+
+  !     ==== COMPUTED IN RADITE ===
+  !     ------------------------------------------------------------------
+  !*       0.2   LOCAL ARRAYS.
+  !              -------------
+  REAL(KIND=JPRB) :: ZRAER  (KPROMA,6,KLEV)
+  REAL(KIND=JPRB) :: ZRCLC  (KPROMA,KLEV)
+  REAL(KIND=JPRB) :: ZRMU0  (KPROMA)
+  REAL(KIND=JPRB) :: ZRPR   (KPROMA,KLEV)
+  REAL(KIND=JPRB) :: ZRTI   (KPROMA,KLEV)
+  REAL(KIND=JPRB) :: ZQLWP (KPROMA,KLEV ) , ZQIWP (KPROMA,KLEV )
+
+  REAL(KIND=JPRB) :: ZPQO3 (KPROMA,KLEV)
+  REAL(KIND=JPRB) :: ZQOZ (NGPTOT,KLEV)
+  REAL(KIND=JPRB) :: ZQS    (KPROMA,KLEV)
+  REAL(KIND=JPRB) :: ZQ     (KPROMA,KLEV)
+  REAL(KIND=JPRB) :: ZEMTD  (KPROMA,KLEV+1)
+  REAL(KIND=JPRB) :: ZEMTU  (KPROMA,KLEV+1)
+  REAL(KIND=JPRB) :: ZTRSOC (KPROMA,2)
+  REAL(KIND=JPRB) :: ZEMTC  (KPROMA,2)
+
+  REAL(KIND=JPRB) :: ZNBAS  (KPROMA)
+  REAL(KIND=JPRB) :: ZNTOP  (KPROMA)
+  REAL(KIND=JPRB) :: ZQRAIN (KPROMA,KLEV)
+  REAL(KIND=JPRB) :: ZQRAINT(KPROMA,KLEV)
+  REAL(KIND=JPRB) :: ZCCNL  (KPROMA)
+  REAL(KIND=JPRB) :: ZCCNO  (KPROMA)
+
+  !  output of radlsw
+
+  REAL(KIND=JPRB) :: ZEMIT  (KPROMA)
+  REAL(KIND=JPRB) :: ZFCT   (KPROMA,KLEV+1)
+  REAL(KIND=JPRB) :: ZFLT   (KPROMA,KLEV+1)
+  REAL(KIND=JPRB) :: ZFCS   (KPROMA,KLEV+1)
+  REAL(KIND=JPRB) :: ZFLS   (KPROMA,KLEV+1)
+  REAL(KIND=JPRB) :: ZFRSOD (KPROMA),ZSUDU(KPROMA)
+  REAL(KIND=JPRB) :: ZPARF  (KPROMA),ZUVDF(KPROMA),ZPARCF(KPROMA),ZTINCF(KPROMA)
+
+  INTEGER(KIND=JPIM) :: IBEG, IEND, JK, JL
+
+  REAL(KIND=JPRB) :: ZCRAE, ZRII0, ZEMIW(KPROMA)
+  REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+  !---aerosol radiative diagnostics
+  ! Key to define the aerosol effect acting on climate
+  ! OB: AEROSOLFEEDBACK_ACTIVE is now a LOGICAL
+  ! TRUE: fluxes use natural and/or anthropogenic aerosols according to ok_ade and ok_aie, DEFAULT
+  ! FALSE: fluxes use no aerosols (case 1) 
+  ! to be used only for maintaining bit reproducibility with aerosol diagnostics activated
+  LOGICAL :: AEROSOLFEEDBACK_ACTIVE ! now externalized from .def files
+
+  !OB - Fluxes including aerosol effects
+  !              |        direct effect
+  !ind effect    | no aerosol  NATural  TOTal
+  !standard      |   5
+  !natural (PI)  |               1       3     
+  !total   (PD)  |               2       4   
+  ! so we need which case when ?
+  ! if flag_aerosol is on
+  ! ok_ade and ok_aie         = 4-2, 4-3 and 4 to proceed
+  ! ok_ade and not ok_aie     = 3-1 and 3 to proceed
+  ! not ok_ade and ok_aie     = 2-1 and 2 to proceed
+  ! not ok_ade and not ok_aie = 1 to proceed
+  ! therefore the cases have the following corresponding switches
+  ! 1 = not ok_ade and not ok_aie OR not ok_ade and ok_aie and swaero_diag OR ok_ade and not ok_aie and swaero_diag
+  ! 2 = not ok_ade and ok_aie OR ok_aie and ok_ade and swaero_diag
+  ! 3 = ok_ade and not ok_aie OR ok_aie and ok_ade and swaero_diag
+  ! 4 = ok_ade and ok_aie
+  ! 5 = no aerosol feedback wanted or no aerosol at all 
+  ! if they are called in this order then the correct call is used to proceed
+
+  REAL(KIND=JPRB) ::  ZFSUP_AERO(KPROMA,KLEV+1,5)
+  REAL(KIND=JPRB) ::  ZFSDN_AERO(KPROMA,KLEV+1,5)
+  REAL(KIND=JPRB) ::  ZFSUP0_AERO(KPROMA,KLEV+1,5)
+  REAL(KIND=JPRB) ::  ZFSDN0_AERO(KPROMA,KLEV+1,5)
+  !--LW (CK):
+  REAL(KIND=JPRB) ::  LWUP_AERO(KPROMA,KLEV+1,5)
+  REAL(KIND=JPRB) ::  LWDN_AERO(KPROMA,KLEV+1,5)
+  REAL(KIND=JPRB) ::  LWUP0_AERO(KPROMA,KLEV+1,5)
+  REAL(KIND=JPRB) ::  LWDN0_AERO(KPROMA,KLEV+1,5)
+
+#include "radlsw.intfb.h"
+
+  IF (LHOOK) CALL DR_HOOK('RECMWF_AERO',0,ZHOOK_HANDLE)
+  IBEG=KST
+  IEND=KEND
+
+  AEROSOLFEEDBACK_ACTIVE = flag_aer_feedback !NL: externalize aer feedback
+
+
+  !*       1.    PREPARATORY WORK
+  !              ----------------
+  !--OB
+  !        1.0    INITIALIZATIONS
+  !               --------------
+
+  ZFSUP_AERO (:,:,:)=0.
+  ZFSDN_AERO (:,:,:)=0.
+  ZFSUP0_AERO(:,:,:)=0.
+  ZFSDN0_AERO(:,:,:)=0.
+
+  LWUP_AERO (:,:,:)=0.
+  LWDN_AERO (:,:,:)=0.
+  LWUP0_AERO(:,:,:)=0.
+  LWDN0_AERO(:,:,:)=0.
+
+  PTAU_ZERO(:,:,:) =1.e-15
+  PPIZA_ZERO(:,:,:)=1.0
+  PCGA_ZERO(:,:,:) =0.0
+
+  PTAU_LW_ZERO(:,:,:) =1.e-15
+
+
+  !*       1.1    LOCAL CONSTANTS
+  !                ---------------
+
+  ZRII0=RII0
+  ZCRAE=RRAE*(RRAE+2.0_JPRB)
+
+  !*       2.1    FULL-LEVEL QUANTITIES
+
+  ZRPR =PAPRSF
+
+  DO JK=1,KLEV
+     DO JL=IBEG,IEND
+        !   ZPQO3(JL,JK)=PQO3(JL,JK)*PDP(JL,JK)*RMD/RMO3
+        ZPQO3(JL,JK)=PQO3(JL,JK)*PDP(JL,JK)
+        ZRCLC(JL,JK)=MAX( 0.0_JPRB ,MIN( 1.0_JPRB ,PCLFR(JL,JK)))
+        IF (ZRCLC(JL,JK) > REPCLC) THEN
+           ZQLWP(JL,JK)=PQLWP(JL,JK)
+           ZQIWP(JL,JK)=PQIWP(JL,JK)
+        ELSE
+           ZQLWP(JL,JK)=REPH2O*ZRCLC(JL,JK)
+           ZQIWP(JL,JK)=REPH2O*ZRCLC(JL,JK)
+        ENDIF
+        ZQRAIN(JL,JK)=0.
+        ZQRAINT(JL,JK)=0.
+        ZRTI(JL,JK) =PT(JL,JK)
+        ZQS (JL,JK)=MAX(2.0_JPRB*REPH2O,PQS(JL,JK))
+        ZQ  (JL,JK)=MAX(REPH2O,MIN(PQ(JL,JK),ZQS(JL,JK)*(1.0_JPRB-REPH2O)))
+        ZEMIW(JL)=PEMIS(JL)
+     ENDDO
+  ENDDO
+
+  IF (NAER == 0) THEN
+     ZRAER=RCAEROS
+  ELSE
+     DO JK=1,KLEV
+        DO JL=IBEG,IEND
+           ZRAER(JL,1,JK)=PAER(JL,JK,1)
+           ZRAER(JL,2,JK)=PAER(JL,JK,2)
+           ZRAER(JL,3,JK)=PAER(JL,JK,3)
+           ZRAER(JL,4,JK)=PAER(JL,JK,4)
+           ZRAER(JL,5,JK)=RCAEROS
+           ZRAER(JL,6,JK)=PAER(JL,JK,6)
+        ENDDO
+     ENDDO
+  ENDIF
+
+  !*       2.2    HALF-LEVEL QUANTITIES
+
+  DO JK=2,KLEV
+     DO JL=IBEG,IEND
+        PTH(JL,JK)=&
+             & (PT(JL,JK-1)*PAPRSF(JL,JK-1)*(PAPRSF(JL,JK)-PAPRS(JL,JK))&
+             & +PT(JL,JK)*PAPRSF(JL,JK)*(PAPRS(JL,JK)-PAPRSF(JL,JK-1)))&
+             & *(1.0_JPRB/(PAPRS(JL,JK)*(PAPRSF(JL,JK)-PAPRSF(JL,JK-1))))  
+     ENDDO
+  ENDDO
+
+  !*       2.3     QUANTITIES AT BOUNDARIES
+
+  DO JL=IBEG,IEND
+     PTH(JL,KLEV+1)=PTS(JL)
+     PTH(JL,1)=PT(JL,1)-PAPRSF(JL,1)*(PT(JL,1)-PTH(JL,2))&
+          & /(PAPRSF(JL,1)-PAPRS(JL,2))  
+     ZNBAS(JL)=1. 
+     ZNTOP(JL)=1.
+     ZCCNL(JL)=RCCNLND
+     ZCCNO(JL)=RCCNSEA
+  ENDDO
+
+  !*       3.1     SOLAR ZENITH ANGLE IS EARTH'S CURVATURE
+  !                CORRECTED
+
+  ! CCMVAL: on impose ZRMU0=PMU0 MPL 25032010
+  ! 2eme essai en 3D MPL 20052010
+  !DO JL=IBEG,IEND
+  ! ZRMU0(JL)=PMU0(JL)
+  !ENDDO
+!!!!! A REVOIR MPL 20091201: enleve cette correction pour comparer a AR4
+  DO JL=IBEG,IEND
+     IF (PMU0(JL) > 1.E-10_JPRB) THEN
+        ZRMU0(JL)=RRAE/(SQRT(PMU0(JL)**2+ZCRAE)-PMU0(JL))
+     ELSE
+        ZRMU0(JL)= RRAE/SQRT(ZCRAE)
+     ENDIF
+  ENDDO
+
+  !*         4.1     CALL TO ACTUAL RADIATION SCHEME
+  !
+  !----now we make multiple calls to the radiation according to which 
+  !----aerosol flags are on
+
+  IF (flag_aerosol .GT. 0 .OR. flag_aerosol_strat) THEN
+
+     !--Case 1
+     IF ( ( .not. ok_ade .AND. .not. ok_aie ) .OR.             & 
+          & ( .not. ok_ade .AND. ok_aie .AND. swaero_diag ) .OR. & 
+          & ( ok_ade .AND. .not. ok_aie .AND. swaero_diag ) ) THEN
+
+        ! natural aerosols for direct and indirect effect 
+        ! PI cloud optical properties
+        ! use PREF_LIQ_PI and PREF_ICE_PI
+        ! use NAT aerosol optical properties
+        ! store fluxes in index 1
+
+        CALL RADLSW (&
+             & IBEG  , IEND   , KPROMA  , KLEV  , KMODE , NAER,&
+             & ZRII0 ,&
+             & ZRAER , PALBD  , PALBP   , PAPRS , ZRPR  ,&
+             & ZCCNL , ZCCNO  ,&
+             & PCCO2 , ZRCLC  , PDP     , PEMIS , ZEMIW ,PSLM    , ZRMU0 , ZPQO3,&
+             & ZQ    , ZQIWP  , ZQLWP   , ZQS   , ZQRAIN,ZQRAINT ,&
+             & PTH   , ZRTI   , PTS     , ZNBAS , ZNTOP ,&
+             & PREF_LIQ_PI, PREF_ICE_PI,&
+             & ZEMIT , ZFCT   , ZFLT    , ZFCS    , ZFLS  ,&
+             & ZFRSOD, ZSUDU  , ZUVDF   , ZPARF   , ZPARCF, ZTINCF, PSFSWDIR,&
+             & PSFSWDIF,PFSDNN, PFSDNV  ,&  
+             & LRDUST,PPIZA_NAT,PCGA_NAT,PTAU_NAT,PTAU_LW_NAT,PFLUX,PFLUC,&
+             & PFSDN , PFSUP  , PFSCDN  , PFSCUP )
+
+        !* SAVE VARIABLES IN INTERIM VARIABLES A LA SW_AEROAR4
+        ZFSUP0_AERO(:,:,1) = PFSCUP(:,:)
+        ZFSDN0_AERO(:,:,1) = PFSCDN(:,:)
+
+        ZFSUP_AERO(:,:,1) =  PFSUP(:,:)
+        ZFSDN_AERO(:,:,1) =  PFSDN(:,:)
+
+        LWUP0_AERO(:,:,1) = PFLUC(:,1,:)
+        LWDN0_AERO(:,:,1) = PFLUC(:,2,:)
+
+        LWUP_AERO(:,:,1) = PFLUX(:,1,:)
+        LWDN_AERO(:,:,1) = PFLUX(:,2,:)
+
+     ENDIF
+
+     !--Case 2
+     IF ( ( .not. ok_ade .AND. ok_aie ) .OR. & 
+          & ( ok_ade .AND. ok_aie .AND. swaero_diag ) ) THEN
+
+        ! natural aerosols for direct indirect effect 
+        ! use NAT aerosol optical properties 
+        ! PD cloud optical properties
+        ! use PREF_LIQ and PREF_ICE
+        ! store fluxes in index 2
+
+        CALL RADLSW (&
+             & IBEG  , IEND   , KPROMA  , KLEV  , KMODE , NAER,&
+             & ZRII0 ,&
+             & ZRAER , PALBD  , PALBP   , PAPRS , ZRPR  ,&
+             & ZCCNL , ZCCNO  ,&
+             & PCCO2 , ZRCLC  , PDP     , PEMIS , ZEMIW ,PSLM    , ZRMU0 , ZPQO3,&
+             & ZQ    , ZQIWP  , ZQLWP   , ZQS   , ZQRAIN,ZQRAINT ,&
+             & PTH   , ZRTI   , PTS     , ZNBAS , ZNTOP ,&
+             & PREF_LIQ, PREF_ICE,&
+             & ZEMIT , ZFCT   , ZFLT    , ZFCS    , ZFLS  ,&
+             & ZFRSOD, ZSUDU  , ZUVDF   , ZPARF   , ZPARCF, ZTINCF, PSFSWDIR,&
+             & PSFSWDIF,PFSDNN, PFSDNV  ,&  
+             & LRDUST,PPIZA_NAT,PCGA_NAT,PTAU_NAT,PTAU_LW_NAT,PFLUX,PFLUC,&
+             & PFSDN , PFSUP  , PFSCDN  , PFSCUP )
+
+        !* SAVE VARIABLES IN INTERIM VARIABLES A LA SW_AEROAR4
+        ZFSUP0_AERO(:,:,2) = PFSCUP(:,:)
+        ZFSDN0_AERO(:,:,2) = PFSCDN(:,:)
+
+        ZFSUP_AERO(:,:,2) =  PFSUP(:,:)
+        ZFSDN_AERO(:,:,2) =  PFSDN(:,:)
+
+        LWUP0_AERO(:,:,2) = PFLUC(:,1,:)
+        LWDN0_AERO(:,:,2) = PFLUC(:,2,:)
+
+        LWUP_AERO(:,:,2) = PFLUX(:,1,:)
+        LWDN_AERO(:,:,2) = PFLUX(:,2,:)
+
+     ENDIF ! ok_aie      
+
+     !--Case 3
+     IF ( ( ok_ade .AND. .not. ok_aie ) .OR. &
+          & ( ok_ade .AND. ok_aie .AND. swaero_diag ) ) THEN
+
+        ! direct effect of total aerosol activated
+        ! TOT aerosols for direct effect
+        ! PI cloud optical properties
+        ! use PREF_LIQ_PI and PREF_ICE_PI
+        ! STORE fluxes in index 3
+
+        CALL RADLSW (&
+             & IBEG  , IEND   , KPROMA  , KLEV  , KMODE , NAER,&
+             & ZRII0 ,&
+             & ZRAER , PALBD  , PALBP   , PAPRS , ZRPR  ,&
+             & ZCCNL , ZCCNO  ,&
+             & PCCO2 , ZRCLC  , PDP     , PEMIS , ZEMIW ,PSLM    , ZRMU0 , ZPQO3,&
+             & ZQ    , ZQIWP  , ZQLWP   , ZQS   , ZQRAIN,ZQRAINT ,&
+             & PTH   , ZRTI   , PTS     , ZNBAS , ZNTOP ,&
+             & PREF_LIQ_PI, PREF_ICE_PI,&
+             & ZEMIT , ZFCT   , ZFLT    , ZFCS    , ZFLS  ,&
+             & ZFRSOD, ZSUDU  , ZUVDF   , ZPARF   , ZPARCF, ZTINCF, PSFSWDIR,&
+             & PSFSWDIF,PFSDNN, PFSDNV  ,&  
+             & LRDUST,PPIZA_TOT,PCGA_TOT,PTAU_TOT,PTAU_LW_TOT,PFLUX,PFLUC,&
+             & PFSDN , PFSUP  , PFSCDN  , PFSCUP )
+
+        !* SAVE VARIABLES IN INTERIM VARIABLES A LA SW_AEROAR4
+        ZFSUP0_AERO(:,:,3) = PFSCUP(:,:)
+        ZFSDN0_AERO(:,:,3) = PFSCDN(:,:)
+
+        ZFSUP_AERO(:,:,3) =  PFSUP(:,:)
+        ZFSDN_AERO(:,:,3) =  PFSDN(:,:)
+
+        LWUP0_AERO(:,:,3) = PFLUC(:,1,:)
+        LWDN0_AERO(:,:,3) = PFLUC(:,2,:)
+
+        LWUP_AERO(:,:,3) = PFLUX(:,1,:)
+        LWDN_AERO(:,:,3) = PFLUX(:,2,:)
+
+     ENDIF !-end ok_ade
+
+     !--Case 4
+     IF (ok_ade .and. ok_aie) THEN
+
+        ! total aerosols for direct indirect effect 
+        ! use TOT aerosol optical properties 
+        ! PD cloud optical properties
+        ! use PREF_LIQ and PREF_ICE
+        ! store fluxes in index 4 
+
+        CALL RADLSW (&
+             & IBEG  , IEND   , KPROMA  , KLEV  , KMODE , NAER,&
+             & ZRII0 ,&
+             & ZRAER , PALBD  , PALBP   , PAPRS , ZRPR  ,&
+             & ZCCNL , ZCCNO  ,&
+             & PCCO2 , ZRCLC  , PDP     , PEMIS , ZEMIW ,PSLM    , ZRMU0 , ZPQO3,&
+             & ZQ    , ZQIWP  , ZQLWP   , ZQS   , ZQRAIN,ZQRAINT ,&
+             & PTH   , ZRTI   , PTS     , ZNBAS , ZNTOP ,&
+             & PREF_LIQ, PREF_ICE,&
+             & ZEMIT , ZFCT   , ZFLT    , ZFCS    , ZFLS  ,&
+             & ZFRSOD, ZSUDU  , ZUVDF   , ZPARF   , ZPARCF, ZTINCF, PSFSWDIR,&
+             & PSFSWDIF,PFSDNN, PFSDNV  ,&  
+             & LRDUST,PPIZA_TOT,PCGA_TOT,PTAU_TOT,PTAU_LW_TOT,PFLUX,PFLUC,&
+             & PFSDN , PFSUP  , PFSCDN  , PFSCUP )
+
+        !* SAVE VARIABLES IN INTERIM VARIABLES A LA SW_AEROAR4
+        ZFSUP0_AERO(:,:,4) = PFSCUP(:,:)
+        ZFSDN0_AERO(:,:,4) = PFSCDN(:,:)
+
+        ZFSUP_AERO(:,:,4) =  PFSUP(:,:)
+        ZFSDN_AERO(:,:,4) =  PFSDN(:,:)
+
+        LWUP0_AERO(:,:,4) = PFLUC(:,1,:)
+        LWDN0_AERO(:,:,4) = PFLUC(:,2,:)
+
+        LWUP_AERO(:,:,4) = PFLUX(:,1,:)
+        LWDN_AERO(:,:,4) = PFLUX(:,2,:)
+
+     ENDIF ! ok_ade .and. ok_aie
+
+  ENDIF !--if flag_aerosol GT 0 OR flag_aerosol_strat
+
+  ! case with no aerosols at all is also computed IF ACTIVEFEEDBACK_ACTIVE is false 
+  IF (.not. AEROSOLFEEDBACK_ACTIVE .OR. flag_aerosol .EQ. 0 .OR. swaerofree_diag) THEN    
+
+     ! ZERO aerosol effect
+     ! ZERO aerosol optical depth
+     ! STANDARD cloud optical properties
+     ! STORE fluxes in index 5
+
+     CALL RADLSW (&
+          & IBEG  , IEND   , KPROMA  , KLEV  , KMODE , NAER,&
+          & ZRII0 ,&
+          & ZRAER , PALBD  , PALBP   , PAPRS , ZRPR  ,&
+          & ZCCNL , ZCCNO  ,&
+          & PCCO2 , ZRCLC  , PDP     , PEMIS , ZEMIW ,PSLM    , ZRMU0 , ZPQO3,&
+          & ZQ    , ZQIWP  , ZQLWP   , ZQS   , ZQRAIN,ZQRAINT ,&
+          & PTH   , ZRTI   , PTS     , ZNBAS , ZNTOP ,&
+          !--this needs to be changed to fixed cloud optical properties
+          & PREF_LIQ_PI, PREF_ICE_PI,&
+          & ZEMIT , ZFCT   , ZFLT    , ZFCS    , ZFLS  ,&
+          & ZFRSOD, ZSUDU  , ZUVDF   , ZPARF   , ZPARCF, ZTINCF, PSFSWDIR,&
+          & PSFSWDIF,PFSDNN, PFSDNV  ,&  
+          & LRDUST,PPIZA_ZERO,PCGA_ZERO,PTAU_ZERO, PTAU_LW_ZERO,PFLUX,PFLUC,&
+          & PFSDN , PFSUP  , PFSCDN  , PFSCUP )
+
+     !* SAVE VARIABLES IN INTERIM VARIABLES A LA SW_AEROAR4
+     ZFSUP0_AERO(:,:,5) = PFSCUP(:,:)
+     ZFSDN0_AERO(:,:,5) = PFSCDN(:,:)
+
+     ZFSUP_AERO(:,:,5) =  PFSUP(:,:)
+     ZFSDN_AERO(:,:,5) =  PFSDN(:,:)
+
+     LWUP0_AERO(:,:,5) = PFLUC(:,1,:)
+     LWDN0_AERO(:,:,5) = PFLUC(:,2,:)
+
+     LWUP_AERO(:,:,5) = PFLUX(:,1,:)
+     LWDN_AERO(:,:,5) = PFLUX(:,2,:)
+
+  ENDIF ! .not. AEROSOLFEEDBACK_ACTIVE
+
+  !*         4.2     TRANSFORM FLUXES TO MODEL HISTORICAL VARIABLES
+
+  DO JK=1,KLEV+1
+     DO JL=IBEG,IEND
+        PSWFT(JL,JK)=ZFLS(JL,JK)/(ZRII0*ZRMU0(JL))
+        PLWFT(JL,JK)=ZFLT(JL,JK)
+     ENDDO
+  ENDDO
+
+  ZEMTD=PLWFT
+  ZEMTU=PLWFT
+
+  DO JL=IBEG,IEND
+     ZTRSOC(JL, 1)=ZFCS(JL,     1)/(ZRII0*ZRMU0(JL))
+     ZTRSOC(JL, 2)=ZFCS(JL,KLEV+1)/(ZRII0*ZRMU0(JL))
+     ZEMTC (JL, 1)=ZFCT(JL,     1)
+     ZEMTC (JL, 2)=ZFCT(JL,KLEV+1)
+  ENDDO
+
+  !                 ------------ -- ------- -- ---- -----
+  !*         5.1    STORAGE OF TRANSMISSIVITY AND EMISSIVITIES
+  !*                IN KPROMA-LONG ARRAYS
+
+  DO JK=1,KLEV+1
+     DO JL=IBEG,IEND
+        PEMTD(JL,JK)=ZEMTD(JL,JK)
+        PEMTU(JL,JK)=ZEMTU(JL,JK)
+        PTRSO(JL,JK)=MAX(0.0_JPRB,MIN(1.0_JPRB,PSWFT(JL,JK)))
+     ENDDO
+  ENDDO
+  DO JK=1,2
+     DO JL=IBEG,IEND
+        PCEMTR(JL,JK)=ZEMTC (JL,JK)
+        PCTRSO(JL,JK)=MAX( 0.0_JPRB,MIN(1.0_JPRB,ZTRSOC(JL,JK)))
+     ENDDO
+  ENDDO
+  DO JL=IBEG,IEND
+     PTRSOD(JL)=MAX(0.0_JPRB,MIN(1.0_JPRB,ZFRSOD(JL)/(ZRII0*ZRMU0(JL))))
+  ENDDO
+
+  !*         7.3   RECONSTRUCT FLUXES FOR DIAGNOSTICS
+
+  DO JL=IBEG,IEND
+     IF (PMU0(JL) < 1.E-10_JPRB) ZRMU0(JL)=0.0_JPRB
+  ENDDO
+  DO JK=1,KLEV+1
+     DO JL=IBEG,IEND
+        PLWFT(JL,JK)=PEMTD(JL,JK)
+        PSWFT(JL,JK)=ZRMU0(JL)*ZRII0*PTRSO(JL,JK)
+     ENDDO
+  ENDDO
+  DO JK=1,2
+     DO JL=IBEG,IEND
+        PSWFC(JL,JK)=ZRMU0(JL)*ZRII0*PCTRSO(JL,JK)
+        PLWFC(JL,JK)=PCEMTR(JL,JK)
+     ENDDO
+  ENDDO
+
+  !*  8.0 DIAGNOSTICS
+  !---Now we copy back the correct fields to proceed to the next timestep
+
+  IF  ( AEROSOLFEEDBACK_ACTIVE .AND. (flag_aerosol .GT. 0 .OR. flag_aerosol_strat) ) THEN
+
+     IF ( ok_ade .and. ok_aie  ) THEN
+        PFSUP(:,:) =    ZFSUP_AERO(:,:,4)
+        PFSDN(:,:) =    ZFSDN_AERO(:,:,4)
+        PFSCUP(:,:) =   ZFSUP0_AERO(:,:,4)
+        PFSCDN(:,:) =   ZFSDN0_AERO(:,:,4)
+
+        PFLUX(:,1,:) =  LWUP_AERO(:,:,4)
+        PFLUX(:,2,:) =  LWDN_AERO(:,:,4)
+        PFLUC(:,1,:) =  LWUP0_AERO(:,:,4)
+        PFLUC(:,2,:) =  LWDN0_AERO(:,:,4)    
+     ENDIF
+
+     IF ( ok_ade .and. (.not. ok_aie) )  THEN
+        PFSUP(:,:) =    ZFSUP_AERO(:,:,3)
+        PFSDN(:,:) =    ZFSDN_AERO(:,:,3)
+        PFSCUP(:,:) =   ZFSUP0_AERO(:,:,3)
+        PFSCDN(:,:) =   ZFSDN0_AERO(:,:,3)
+
+        PFLUX(:,1,:) =  LWUP_AERO(:,:,3)
+        PFLUX(:,2,:) =  LWDN_AERO(:,:,3)
+        PFLUC(:,1,:) =  LWUP0_AERO(:,:,3)
+        PFLUC(:,2,:) =  LWDN0_AERO(:,:,3) 
+     ENDIF
+
+     IF ( (.not. ok_ade) .and. ok_aie  )  THEN
+        PFSUP(:,:) =    ZFSUP_AERO(:,:,2)
+        PFSDN(:,:) =    ZFSDN_AERO(:,:,2)
+        PFSCUP(:,:) =   ZFSUP0_AERO(:,:,2)
+        PFSCDN(:,:) =   ZFSDN0_AERO(:,:,2)
+
+        PFLUX(:,1,:) =  LWUP_AERO(:,:,2)
+        PFLUX(:,2,:) =  LWDN_AERO(:,:,2)
+        PFLUC(:,1,:) =  LWUP0_AERO(:,:,2)
+        PFLUC(:,2,:) =  LWDN0_AERO(:,:,2) 
+     ENDiF
+
+     IF ((.not. ok_ade) .and. (.not. ok_aie)) THEN
+        PFSUP(:,:) =    ZFSUP_AERO(:,:,1)
+        PFSDN(:,:) =    ZFSDN_AERO(:,:,1)
+        PFSCUP(:,:) =   ZFSUP0_AERO(:,:,1)
+        PFSCDN(:,:) =   ZFSDN0_AERO(:,:,1)
+
+        PFLUX(:,1,:) =  LWUP_AERO(:,:,1)
+        PFLUX(:,2,:) =  LWDN_AERO(:,:,1)
+        PFLUC(:,1,:) =  LWUP0_AERO(:,:,1)
+        PFLUC(:,2,:) =  LWDN0_AERO(:,:,1) 
+     ENDIF
+
+     ! The following allows to compute the forcing diagostics without
+     ! letting the aerosol forcing act on the meteorology
+     ! SEE logic above
+
+  ELSE  !--not AEROSOLFEEDBACK_ACTIVE
+
+     PFSUP(:,:) =    ZFSUP_AERO(:,:,5)
+     PFSDN(:,:) =    ZFSDN_AERO(:,:,5)
+     PFSCUP(:,:) =   ZFSUP0_AERO(:,:,5)
+     PFSCDN(:,:) =   ZFSDN0_AERO(:,:,5)
+
+     PFLUX(:,1,:) =  LWUP_AERO(:,:,5)
+     PFLUX(:,2,:) =  LWDN_AERO(:,:,5)
+     PFLUC(:,1,:) =  LWUP0_AERO(:,:,5)
+     PFLUC(:,2,:) =  LWDN0_AERO(:,:,5) 
+
+  ENDIF
+
+  !--VolMIP Strat/Surf
+  !--only ok_ade + ok_aie case treated
+  IF (ok_ade.AND.ok_aie.AND.ok_volcan) THEN
+     !--in this case the fluxes used for the heating rates come from case 4 but SW surface radiation is kept from case 2
+     IF (flag_volc_surfstrat.EQ.2) THEN ! STRAT HEATING
+        volmip_solsw(:)= ZFSDN_AERO(:,1,2)-ZFSUP_AERO(:,1,2)
+     ELSEIF (flag_volc_surfstrat.EQ.1) THEN ! SURF COOLING
+        !--in this case the fluxes used for the heating rates come from case 2 but SW surface radiation is kept from case 4
+        PFSUP(:,:) =    ZFSUP_AERO(:,:,2)
+        PFSDN(:,:) =    ZFSDN_AERO(:,:,2)
+        PFSCUP(:,:) =   ZFSUP0_AERO(:,:,2)
+        PFSCDN(:,:) =   ZFSDN0_AERO(:,:,2)
+        PFLUX(:,1,:) =  LWUP_AERO(:,:,2)
+        PFLUX(:,2,:) =  LWDN_AERO(:,:,2)
+        PFLUC(:,1,:) =  LWDN0_AERO(:,:,2) 
+        PFLUC(:,2,:) =  LWDN0_AERO(:,:,2)
+        volmip_solsw(:)= ZFSDN_AERO(:,1,4)-ZFSUP_AERO(:,1,4)
+     ENDIF
+  ENDIF
+  !--End VolMIP Strat/Surf
+
+  IF (swaerofree_diag) THEN
+     ! copy shortwave clear-sky clean (no aerosol) case
+     PFSCCUP(:,:) =   ZFSUP0_AERO(:,:,5)
+     PFSCCDN(:,:) =   ZFSDN0_AERO(:,:,5)
+     ! copy longwave clear-sky clean (no aerosol) case
+     PFLCCUP(:,:) =   LWUP0_AERO(:,:,5)
+     PFLCCDN(:,:) =   LWDN0_AERO(:,:,5)
+  ENDIF
+
+  !OB- HERE CHECK WITH MP IF BOTTOM AND TOP INDICES ARE OK !!!!!!!!!!!!!!!!!!
+  ! net anthropogenic forcing direct and 1st indirect effect diagnostics
+  ! requires a natural aerosol field read and used 
+  ! Difference of net fluxes from double call to radiation
+  ! Will need to be extended to LW radiation -> done by CK (2014-05-23)
+
+  IF (flag_aerosol .GT. 0 .OR. flag_aerosol_strat) THEN
+
+     IF (ok_ade.AND.ok_aie) THEN
+
+        ! direct anthropogenic forcing
+        PSOLSWADAERO(:)  = (ZFSDN_AERO(:,1,4)      -ZFSUP_AERO(:,1,4))      -(ZFSDN_AERO(:,1,2)      -ZFSUP_AERO(:,1,2))
+        PTOPSWADAERO(:)  = (ZFSDN_AERO(:,KLEV+1,4) -ZFSUP_AERO(:,KLEV+1,4)) -(ZFSDN_AERO(:,KLEV+1,2) -ZFSUP_AERO(:,KLEV+1,2))
+        PSOLSWAD0AERO(:) = (ZFSDN0_AERO(:,1,4)     -ZFSUP0_AERO(:,1,4))     -(ZFSDN0_AERO(:,1,2)     -ZFSUP0_AERO(:,1,2))
+        PTOPSWAD0AERO(:) = (ZFSDN0_AERO(:,KLEV+1,4)-ZFSUP0_AERO(:,KLEV+1,4))-(ZFSDN0_AERO(:,KLEV+1,2)-ZFSUP0_AERO(:,KLEV+1,2))
+        IF(ok_volcan) THEN
+           PSWADAERO(:,:)  = (ZFSDN_AERO(:,:,4) -ZFSUP_AERO(:,:,4)) -(ZFSDN_AERO(:,:,2) -ZFSUP_AERO(:,:,2)) !--NL
+        ENDIF
+
+        ! indirect anthropogenic forcing
+        PSOLSWAIAERO(:) = (ZFSDN_AERO(:,1,4)     -ZFSUP_AERO(:,1,4))     -(ZFSDN_AERO(:,1,3)     -ZFSUP_AERO(:,1,3))
+        PTOPSWAIAERO(:) = (ZFSDN_AERO(:,KLEV+1,4)-ZFSUP_AERO(:,KLEV+1,4))-(ZFSDN_AERO(:,KLEV+1,3)-ZFSUP_AERO(:,KLEV+1,3))
+
+        ! Cloud radiative forcing with natural aerosol for direct effect 
+        PSOLSWCFAERO(:,1) = (ZFSDN_AERO(:,1,2)     -ZFSUP_AERO(:,1,2))     -(ZFSDN0_AERO(:,1,2)     -ZFSUP0_AERO(:,1,2))
+        PTOPSWCFAERO(:,1) = (ZFSDN_AERO(:,KLEV+1,2)-ZFSUP_AERO(:,KLEV+1,2))-(ZFSDN0_AERO(:,KLEV+1,2)-ZFSUP0_AERO(:,KLEV+1,2))
+        ! Cloud radiative forcing with anthropogenic aerosol for direct effect 
+        PSOLSWCFAERO(:,2) = (ZFSDN_AERO(:,1,4)     -ZFSUP_AERO(:,1,4))     -(ZFSDN0_AERO(:,1,4)     -ZFSUP0_AERO(:,1,4))
+        PTOPSWCFAERO(:,2) = (ZFSDN_AERO(:,KLEV+1,4)-ZFSUP_AERO(:,KLEV+1,4))-(ZFSDN0_AERO(:,KLEV+1,4)-ZFSUP0_AERO(:,KLEV+1,4))
+        ! Cloud radiative forcing with no direct effect at all 
+        PSOLSWCFAERO(:,3) = 0.0
+        PTOPSWCFAERO(:,3) = 0.0
+
+        ! LW direct anthropogenic forcing
+        PSOLLWADAERO(:)  = (-LWDN_AERO(:,1,4)      -LWUP_AERO(:,1,4))      -(-LWDN_AERO(:,1,2)      -LWUP_AERO(:,1,2))
+        PTOPLWADAERO(:)  = (-LWDN_AERO(:,KLEV+1,4) -LWUP_AERO(:,KLEV+1,4)) -(-LWDN_AERO(:,KLEV+1,2) -LWUP_AERO(:,KLEV+1,2))
+        PSOLLWAD0AERO(:) = (-LWDN0_AERO(:,1,4)     -LWUP0_AERO(:,1,4))     -(-LWDN0_AERO(:,1,2)     -LWUP0_AERO(:,1,2))
+        PTOPLWAD0AERO(:) = (-LWDN0_AERO(:,KLEV+1,4)-LWUP0_AERO(:,KLEV+1,4))-(-LWDN0_AERO(:,KLEV+1,2)-LWUP0_AERO(:,KLEV+1,2))
+        IF(ok_volcan) THEN
+           PLWADAERO(:,:)  = (-LWDN_AERO(:,:,4) -LWUP_AERO(:,:,4)) -(-LWDN_AERO(:,:,2) -LWUP_AERO(:,:,2)) !--NL
+        ENDIF
+
+        ! LW indirect anthropogenic forcing
+        PSOLLWAIAERO(:) = (-LWDN_AERO(:,1,4)     -LWUP_AERO(:,1,4))     -(-LWDN_AERO(:,1,3)     -LWUP_AERO(:,1,3))
+        PTOPLWAIAERO(:) = (-LWDN_AERO(:,KLEV+1,4)-LWUP_AERO(:,KLEV+1,4))-(-LWDN_AERO(:,KLEV+1,3)-LWUP_AERO(:,KLEV+1,3))
+
+     ENDIF
+
+     IF (ok_ade.AND..NOT.ok_aie) THEN
+
+        ! direct anthropogenic forcing
+        PSOLSWADAERO(:)  = (ZFSDN_AERO(:,1,3)      -ZFSUP_AERO(:,1,3))      -(ZFSDN_AERO(:,1,1)      -ZFSUP_AERO(:,1,1))
+        PTOPSWADAERO(:)  = (ZFSDN_AERO(:,KLEV+1,3) -ZFSUP_AERO(:,KLEV+1,3)) -(ZFSDN_AERO(:,KLEV+1,1) -ZFSUP_AERO(:,KLEV+1,1))
+        PSOLSWAD0AERO(:) = (ZFSDN0_AERO(:,1,3)     -ZFSUP0_AERO(:,1,3))     -(ZFSDN0_AERO(:,1,1)     -ZFSUP0_AERO(:,1,1))
+        PTOPSWAD0AERO(:) = (ZFSDN0_AERO(:,KLEV+1,3)-ZFSUP0_AERO(:,KLEV+1,3))-(ZFSDN0_AERO(:,KLEV+1,1)-ZFSUP0_AERO(:,KLEV+1,1))
+        IF(ok_volcan) THEN
+           PSWADAERO(:,:)  = (ZFSDN_AERO(:,:,3) -ZFSUP_AERO(:,:,3)) -(ZFSDN_AERO(:,:,1) -ZFSUP_AERO(:,:,1)) !--NL
+        ENDIF
+
+        ! indirect anthropogenic forcing
+        PSOLSWAIAERO(:) = 0.0
+        PTOPSWAIAERO(:) = 0.0 
+
+        ! Cloud radiative forcing with natural aerosol for direct effect 
+        PSOLSWCFAERO(:,1) = (ZFSDN_AERO(:,1,1)     -ZFSUP_AERO(:,1,1))     -(ZFSDN0_AERO(:,1,1)     -ZFSUP0_AERO(:,1,1))
+        PTOPSWCFAERO(:,1) = (ZFSDN_AERO(:,KLEV+1,1)-ZFSUP_AERO(:,KLEV+1,1))-(ZFSDN0_AERO(:,KLEV+1,1)-ZFSUP0_AERO(:,KLEV+1,1))
+        ! Cloud radiative forcing with anthropogenic aerosol for direct effect 
+        PSOLSWCFAERO(:,2) = (ZFSDN_AERO(:,1,3)     -ZFSUP_AERO(:,1,3))     -(ZFSDN0_AERO(:,1,3)     -ZFSUP0_AERO(:,1,3))
+        PTOPSWCFAERO(:,2) = (ZFSDN_AERO(:,KLEV+1,3)-ZFSUP_AERO(:,KLEV+1,3))-(ZFSDN0_AERO(:,KLEV+1,3)-ZFSUP0_AERO(:,KLEV+1,3))
+        ! Cloud radiative forcing with no direct effect at all 
+        PSOLSWCFAERO(:,3) = 0.0
+        PTOPSWCFAERO(:,3) = 0.0
+
+        ! LW direct anthropogenic forcing
+        PSOLLWADAERO(:)  = (-LWDN_AERO(:,1,3)      -LWUP_AERO(:,1,3))      -(-LWDN_AERO(:,1,1)      -LWUP_AERO(:,1,1))
+        PTOPLWADAERO(:)  = (-LWDN_AERO(:,KLEV+1,3) -LWUP_AERO(:,KLEV+1,3)) -(-LWDN_AERO(:,KLEV+1,1) -LWUP_AERO(:,KLEV+1,1))
+        PSOLLWAD0AERO(:) = (-LWDN0_AERO(:,1,3)     -LWUP0_AERO(:,1,3))     -(-LWDN0_AERO(:,1,1)     -LWUP0_AERO(:,1,1))
+        PTOPLWAD0AERO(:) = (-LWDN0_AERO(:,KLEV+1,3)-LWUP0_AERO(:,KLEV+1,3))-(-LWDN0_AERO(:,KLEV+1,1)-LWUP0_AERO(:,KLEV+1,1))
+        IF(ok_volcan) THEN
+           PLWADAERO(:,:)  = (-LWDN_AERO(:,:,3) -LWUP_AERO(:,:,3)) -(-LWDN_AERO(:,:,1) -LWUP_AERO(:,:,1)) !--NL
+        ENDIF
+
+        ! LW indirect anthropogenic forcing
+        PSOLLWAIAERO(:) = 0.0
+        PTOPLWAIAERO(:) = 0.0 
+
+     ENDIF
+
+     IF (.NOT.ok_ade.AND.ok_aie) THEN
+
+        ! direct anthropogenic forcing
+        PSOLSWADAERO(:)  = 0.0
+        PTOPSWADAERO(:)  = 0.0
+        PSOLSWAD0AERO(:) = 0.0
+        PTOPSWAD0AERO(:) = 0.0
+        IF(ok_volcan) THEN
+           PSWADAERO(:,:)  = 0.0 !--NL
+        ENDIF
+
+        ! indirect anthropogenic forcing
+        PSOLSWAIAERO(:) = (ZFSDN_AERO(:,1,2)     -ZFSUP_AERO(:,1,2))     -(ZFSDN_AERO(:,1,1)     -ZFSUP_AERO(:,1,1))
+        PTOPSWAIAERO(:) = (ZFSDN_AERO(:,KLEV+1,2)-ZFSUP_AERO(:,KLEV+1,2))-(ZFSDN_AERO(:,KLEV+1,1)-ZFSUP_AERO(:,KLEV+1,1))
+
+        ! Cloud radiative forcing with natural aerosol for direct effect 
+        PSOLSWCFAERO(:,1) = (ZFSDN_AERO(:,1,2)     -ZFSUP_AERO(:,1,2))     -(ZFSDN0_AERO(:,1,2)     -ZFSUP0_AERO(:,1,2))
+        PTOPSWCFAERO(:,1) = (ZFSDN_AERO(:,KLEV+1,2)-ZFSUP_AERO(:,KLEV+1,2))-(ZFSDN0_AERO(:,KLEV+1,2)-ZFSUP0_AERO(:,KLEV+1,2))
+        ! Cloud radiative forcing with anthropogenic aerosol for direct effect 
+        PSOLSWCFAERO(:,2) = 0.0
+        PTOPSWCFAERO(:,2) = 0.0
+        ! Cloud radiative forcing with no direct effect at all 
+        PSOLSWCFAERO(:,3) = 0.0
+        PTOPSWCFAERO(:,3) = 0.0
+
+        ! LW direct anthropogenic forcing
+        PSOLLWADAERO(:)  = 0.0
+        PTOPLWADAERO(:)  = 0.0
+        PSOLLWAD0AERO(:) = 0.0
+        PTOPLWAD0AERO(:) = 0.0
+        IF(ok_volcan) THEN
+           PLWADAERO(:,:)  = 0.0 !--NL
+        ENDIF
+
+        ! LW indirect anthropogenic forcing
+        PSOLLWAIAERO(:) = (-LWDN_AERO(:,1,2)     -LWUP_AERO(:,1,2))     -(-LWDN_AERO(:,1,1)     -LWUP_AERO(:,1,1))
+        PTOPLWAIAERO(:) = (-LWDN_AERO(:,KLEV+1,2)-LWUP_AERO(:,KLEV+1,2))-(-LWDN_AERO(:,KLEV+1,1)-LWUP_AERO(:,KLEV+1,1))
+
+     ENDIF
+
+     IF (.NOT.ok_ade.AND..NOT.ok_aie) THEN
+
+        ! direct anthropogenic forcing
+        PSOLSWADAERO(:)  = 0.0
+        PTOPSWADAERO(:)  = 0.0
+        PSOLSWAD0AERO(:) = 0.0
+        PTOPSWAD0AERO(:) = 0.0
+        IF(ok_volcan) THEN
+           PSWADAERO(:,:)  = 0.0 !--NL
+        ENDIF
+
+        ! indirect anthropogenic forcing
+        PSOLSWAIAERO(:) = 0.0 
+        PTOPSWAIAERO(:) = 0.0
+
+        ! Cloud radiative forcing with natural aerosol for direct effect 
+        PSOLSWCFAERO(:,1) = (ZFSDN_AERO(:,1,1)     -ZFSUP_AERO(:,1,1))     -(ZFSDN0_AERO(:,1,1)     -ZFSUP0_AERO(:,1,1))
+        PTOPSWCFAERO(:,1) = (ZFSDN_AERO(:,KLEV+1,1)-ZFSUP_AERO(:,KLEV+1,1))-(ZFSDN0_AERO(:,KLEV+1,1)-ZFSUP0_AERO(:,KLEV+1,1))
+        ! Cloud radiative forcing with anthropogenic aerosol for direct effect 
+        PSOLSWCFAERO(:,2) = 0.0
+        PTOPSWCFAERO(:,2) = 0.0
+        ! Cloud radiative forcing with no direct effect at all 
+        PSOLSWCFAERO(:,3) = 0.0
+        PTOPSWCFAERO(:,3) = 0.0
+
+        ! LW direct anthropogenic forcing
+        PSOLLWADAERO(:)  = 0.0
+        PTOPLWADAERO(:)  = 0.0
+        PSOLLWAD0AERO(:) = 0.0
+        PTOPLWAD0AERO(:) = 0.0
+        IF(ok_volcan) THEN
+           PLWADAERO(:,:)  = 0.0 !--NL
+        ENDIF
+
+        ! LW indirect anthropogenic forcing
+        PSOLLWAIAERO(:) = 0.0 
+        PTOPLWAIAERO(:) = 0.0
+
+     ENDIF
+
+  ENDIF
+
+  !IF (swaero_diag .OR. .NOT. AEROSOLFEEDBACK_ACTIVE) THEN
+  IF (.NOT. AEROSOLFEEDBACK_ACTIVE) THEN
+     ! Cloudforcing without aerosol at all
+     PSOLSWCFAERO(:,3) = (ZFSDN_AERO(:,1,5)     -ZFSUP_AERO(:,1,5))     -(ZFSDN0_AERO(:,1,5)     -ZFSUP0_AERO(:,1,5))
+     PTOPSWCFAERO(:,3) = (ZFSDN_AERO(:,KLEV+1,5)-ZFSUP_AERO(:,KLEV+1,5))-(ZFSDN0_AERO(:,KLEV+1,5)-ZFSUP0_AERO(:,KLEV+1,5))
+
+  ENDIF
+
+  IF (LHOOK) CALL DR_HOOK('RECMWF_AERO',1,ZHOOK_HANDLE)
+END SUBROUTINE RECMWF_AERO
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/rrtm_gasabs1a_140gp.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/rrtm_gasabs1a_140gp.F90	(revision 5133)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/rrtm_gasabs1a_140gp.F90	(revision 5133)
@@ -0,0 +1,157 @@
+SUBROUTINE RRTM_GASABS1A_140GP (KLEV,P_ATR1,P_OD,P_TF1,P_COLDRY,P_WX,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,K_JP,K_JT,K_JT1,P_ONEMINUS,&
+ & P_COLH2O,P_COLCO2,P_COLO3,P_COLN2O,P_COLCH4,P_COLO2,P_CO2MULT,&
+ & K_LAYTROP,K_LAYSWTCH,K_LAYLOW,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  
+
+!     Reformatted for F90 by JJMorcrette, ECMWF, 980714
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE PARRRTM  , ONLY : JPLAY    ,JPBAND   ,JPGPT   ,JPXSEC
+USE YOERRTAB , ONLY : TRANS    ,BPADE
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_ATR1(JPGPT,JPLAY) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_OD(JPGPT,JPLAY) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TF1(JPGPT,JPLAY) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLDRY(JPLAY) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_WX(JPXSEC,JPLAY) ! Amount of trace gases
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUAERL(JPLAY,JPBAND) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(JPLAY) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(JPLAY) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(JPLAY) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(JPLAY) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFAC(JPLAY) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(JPLAY) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(JPLAY) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(JPLAY) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ONEMINUS 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(JPLAY) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLCO2(JPLAY) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLO3(JPLAY) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLN2O(JPLAY) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLCH4(JPLAY) 
+REAL(KIND=JPRB)                  :: P_COLO2(JPLAY) ! Argument NOT used
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_CO2MULT(JPLAY) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYSWTCH 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYLOW 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(JPLAY) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(JPLAY) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(JPLAY) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(JPGPT,JPLAY) 
+!- from AER
+!- from INTFAC      
+!- from INTIND
+!- from PRECISE             
+!- from PROFDATA             
+!- from SELF             
+!- from SP             
+REAL(KIND=JPRB) :: Z_TAU   (JPGPT,JPLAY)
+
+INTEGER(KIND=JPIM) :: IPR, ITR, I_LAY
+
+REAL(KIND=JPRB) :: Z_ODEPTH, Z_SECANG, Z_TF
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "rrtm_taumol1.intfb.h"
+#include "rrtm_taumol10.intfb.h"
+#include "rrtm_taumol11.intfb.h"
+#include "rrtm_taumol12.intfb.h"
+#include "rrtm_taumol13.intfb.h"
+#include "rrtm_taumol14.intfb.h"
+#include "rrtm_taumol15.intfb.h"
+#include "rrtm_taumol16.intfb.h"
+#include "rrtm_taumol2.intfb.h"
+#include "rrtm_taumol3.intfb.h"
+#include "rrtm_taumol4.intfb.h"
+#include "rrtm_taumol5.intfb.h"
+#include "rrtm_taumol6.intfb.h"
+#include "rrtm_taumol7.intfb.h"
+#include "rrtm_taumol8.intfb.h"
+#include "rrtm_taumol9.intfb.h"
+
+!- SECANG is equal to the secant of the diffusivity angle.
+IF (LHOOK) CALL DR_HOOK('RRTM_GASABS1A_140GP',0,ZHOOK_HANDLE)
+Z_SECANG = 1.66_JPRB
+
+CALL RRTM_TAUMOL1  (KLEV,Z_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,K_JP,K_JT,K_JT1,&
+ & P_COLH2O,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  
+CALL RRTM_TAUMOL2  (KLEV,Z_TAU,P_COLDRY,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,K_JP,K_JT,K_JT1,&
+ & P_COLH2O,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  
+CALL RRTM_TAUMOL3  (KLEV,Z_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,K_JP,K_JT,K_JT1,P_ONEMINUS,&
+ & P_COLH2O,P_COLCO2,P_COLN2O,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  
+CALL RRTM_TAUMOL4  (KLEV,Z_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,K_JP,K_JT,K_JT1,P_ONEMINUS,&
+ & P_COLH2O,P_COLCO2,P_COLO3,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  
+CALL RRTM_TAUMOL5  (KLEV,Z_TAU,P_WX,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,K_JP,K_JT,K_JT1,P_ONEMINUS,&
+ & P_COLH2O,P_COLCO2,P_COLO3,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  
+CALL RRTM_TAUMOL6  (KLEV,Z_TAU,P_WX,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,&
+ & P_COLH2O,P_CO2MULT,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  
+CALL RRTM_TAUMOL7  (KLEV,Z_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,P_ONEMINUS,&
+ & P_COLH2O,P_COLO3,P_CO2MULT,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  
+CALL RRTM_TAUMOL8  (KLEV,Z_TAU,P_WX,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,&
+ & P_COLH2O,P_COLO3,P_COLN2O,P_CO2MULT,K_LAYSWTCH,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  
+CALL RRTM_TAUMOL9  (KLEV,Z_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,P_ONEMINUS,&
+ & P_COLH2O,P_COLN2O,P_COLCH4,K_LAYTROP,K_LAYSWTCH,K_LAYLOW,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  
+CALL RRTM_TAUMOL10 (KLEV,Z_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,&
+ & P_COLH2O,K_LAYTROP,PFRAC)  
+CALL RRTM_TAUMOL11 (KLEV,Z_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,&
+ & P_COLH2O,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  
+CALL RRTM_TAUMOL12 (KLEV,Z_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,P_ONEMINUS,&
+ & P_COLH2O,P_COLCO2,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  
+CALL RRTM_TAUMOL13 (KLEV,Z_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,P_ONEMINUS,&
+ & P_COLH2O,P_COLN2O,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  
+CALL RRTM_TAUMOL14 (KLEV,Z_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,&
+ & P_COLCO2,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  
+CALL RRTM_TAUMOL15 (KLEV,Z_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,P_ONEMINUS,&
+ & P_COLH2O,P_COLCO2,P_COLN2O,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  
+CALL RRTM_TAUMOL16 (KLEV,Z_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,P_ONEMINUS,&
+ & P_COLH2O,P_COLCH4,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  
+
+!- Loop over g-channels.
+DO I_LAY = 1, KLEV
+  DO IPR = 1, JPGPT
+    Z_ODEPTH = Z_SECANG * Z_TAU(IPR,I_LAY)
+    P_OD(IPR,I_LAY) = Z_ODEPTH
+    Z_ODEPTH=0.5D0*(ABS(Z_ODEPTH)+Z_ODEPTH)
+
+!-- revised code to get the pre-computed transmission
+!          IF (ODEPTH.LE.0.) PRINT*, 'ODEPTH = ',ODEPTH
+!!  IF (ODEPTH <= _ZERO_)THEN
+!!    ATR1(IPR,LAY) = _ONE_ - TRANS(0)
+!!    TF1(IPR,LAY) = _ZERO_
+!!  ELSE
+
+    Z_TF = Z_ODEPTH/(BPADE+Z_ODEPTH)
+    ITR=INT(5.E+03_JPRB*Z_TF+0.5_JPRB)
+    IF (ITR.LT.0) ITR=0     ! MPL 12.12.08
+    P_ATR1(IPR,I_LAY) = 1.0_JPRB - TRANS(ITR)
+    P_TF1(IPR,I_LAY) = Z_TF
+
+!!  ENDIF
+  ENDDO
+ENDDO
+
+!     -----------------------------------------------------------------
+
+IF (LHOOK) CALL DR_HOOK('RRTM_GASABS1A_140GP',1,ZHOOK_HANDLE)
+END SUBROUTINE RRTM_GASABS1A_140GP
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/rrtm_rtrn1a_140gp.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/rrtm_rtrn1a_140gp.F90	(revision 5133)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/rrtm_rtrn1a_140gp.F90	(revision 5133)
@@ -0,0 +1,899 @@
+SUBROUTINE RRTM_RTRN1A_140GP (KLEV,K_ISTART,K_IEND,K_ICLDLYR,P_CLDFRAC,P_TAUCLD,P_ABSS1,&
+ & P_OD,P_TAUSF1,P_CLFNET,P_CLHTR,P_FNET,P_HTR,P_TOTDFLUC,P_TOTDFLUX,P_TOTUFLUC,P_TOTUFLUX,&
+ & P_TAVEL,PZ,P_TZ,P_TBOUND,PFRAC,P_SEMISS,P_SEMISLW,K_IREFLECT)  
+
+!     Reformatted for F90 by JJMorcrette, ECMWF, 980714
+!     Speed-up by D.Salmond, ECMWF, 9907
+!     Bug-fix by M.J. Iacono, AER, Inc., 9911
+!     Bug-fix by JJMorcrette, ECMWF, 991209 (RAT1, RAT2 initialization)
+!     Speed-up by D. Salmond, ECMWF, 9912
+!     Bug-fix by JJMorcrette, ECMWF, 0005 (extrapolation T<160K)
+!     Speed-up by D. Salmond, ECMWF, 000515
+
+!-* This program calculates the upward fluxes, downward fluxes,
+!   and heating rates for an arbitrary atmosphere.  The input to
+!   this program is the atmospheric profile and all Planck function
+!   information.  First-order "numerical" quadrature is used for the 
+!   angle integration, i.e. only one exponential is computed per layer
+!   per g-value per band.  Cloud overlap is treated with a generalized
+!   maximum/random method in which adjacent cloud layers are treated
+!   with maximum overlap, and non-adjacent cloud groups are treated
+!   with random overlap.  For adjacent cloud layers, cloud information
+!   is carried from the previous two layers.
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE PARRRTM  , ONLY : JPBAND   ,JPGPT   ,JPLAY
+USE YOERRTAB , ONLY : BPADE
+USE YOERRTWN , ONLY : TOTPLNK  ,DELWAVE
+USE YOERRTFTR, ONLY : NGB
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_ISTART 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_IEND 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_ICLDLYR(JPLAY) ! Cloud indicator
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_CLDFRAC(JPLAY) ! Cloud fraction
+REAL(KIND=JPRB)                  :: Z_CLDFRAC(JPLAY) ! Cloud fraction
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUCLD(JPLAY,JPBAND) ! Spectral optical thickness
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ABSS1(JPGPT*JPLAY) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_OD(JPGPT,JPLAY) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUSF1(JPGPT*JPLAY) 
+REAL(KIND=JPRB)                  :: P_CLFNET(0:JPLAY) ! Argument NOT used
+REAL(KIND=JPRB)                  :: P_CLHTR(0:JPLAY) ! Argument NOT used
+REAL(KIND=JPRB)                  :: P_FNET(0:JPLAY) ! Argument NOT used
+REAL(KIND=JPRB)                  :: P_HTR(0:JPLAY) ! Argument NOT used
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TOTDFLUC(0:JPLAY) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TOTDFLUX(0:JPLAY) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TOTUFLUC(0:JPLAY) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TOTUFLUX(0:JPLAY) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAVEL(JPLAY) 
+REAL(KIND=JPRB)                  :: PZ(0:JPLAY) ! Argument NOT used
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TZ(0:JPLAY) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TBOUND 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PFRAC(JPGPT,JPLAY) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SEMISS(JPBAND) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_SEMISLW 
+INTEGER(KIND=JPIM)               :: K_IREFLECT ! Argument NOT used
+!- from PROFILE             
+!- from SP             
+!- from SURFACE             
+INTEGER(KIND=JPIM) :: INDLAY(JPLAY),INDLEV(0:JPLAY)
+
+REAL(KIND=JPRB) :: Z_BBU1(JPGPT*JPLAY),Z_BBUTOT1(JPGPT*JPLAY)
+REAL(KIND=JPRB) :: Z_TLAYFRAC(JPLAY),Z_TLEVFRAC(0:JPLAY)
+REAL(KIND=JPRB) :: Z_BGLEV(JPGPT)
+!-- DS_000515
+REAL(KIND=JPRB) :: Z_PLVL(JPBAND+1,0:JPLAY),Z_PLAY(JPBAND+1,0:JPLAY),Z_WTNUM(3)
+!-- DS_000515
+REAL(KIND=JPRB) :: Z_ODCLDNW(JPGPT,JPLAY)
+REAL(KIND=JPRB) :: Z_SEMIS(JPGPT),Z_RADUEMIT(JPGPT)
+
+REAL(KIND=JPRB) :: Z_RADCLRU1(JPGPT) ,Z_RADCLRD1(JPGPT)
+REAL(KIND=JPRB) :: Z_RADLU1(JPGPT)   ,Z_RADLD1(JPGPT)
+!-- DS_000515
+REAL(KIND=JPRB) :: Z_TRNCLD(JPLAY,JPBAND+1)
+!-- DS_000515
+REAL(KIND=JPRB) :: Z_ABSCLDNW(JPGPT,JPLAY)
+REAL(KIND=JPRB) :: Z_ATOT1(JPGPT*JPLAY)
+
+REAL(KIND=JPRB) :: Z_SURFEMIS(JPBAND),Z_PLNKEMIT(JPBAND)
+
+! dimension of arrays required for cloud overlap calculations
+
+REAL(KIND=JPRB) :: Z_CLRRADU(jpgpt),Z_CLDRADU(jpgpt),Z_OLDCLD(jpgpt)
+REAL(KIND=JPRB) :: Z_OLDCLR(jpgpt),Z_RAD(jpgpt),Z_FACCLD1(jplay+1),Z_FACCLD2(jplay+1)
+REAL(KIND=JPRB) :: Z_FACCLR1(jplay+1),Z_FACCLR2(jplay+1)
+REAL(KIND=JPRB) :: Z_FACCMB1(jplay+1),Z_FACCMB2(jplay+1)
+REAL(KIND=JPRB) :: Z_FACCLD1D(0:jplay),Z_FACCLD2D(0:jplay),Z_FACCLR1D(0:jplay)
+REAL(KIND=JPRB) :: Z_FACCLR2D(0:jplay),Z_FACCMB1D(0:jplay),Z_FACCMB2D(0:jplay)
+REAL(KIND=JPRB) :: Z_CLRRADD(jpgpt),Z_CLDRADD(jpgpt)
+INTEGER(KIND=JPIM) :: istcld(jplay+1),istcldd(0:jplay)
+!******
+
+!REAL_B :: ZPLVL(JPGPT+1,JPLAY)  ,ZPLAY(JPGPT+1,JPLAY)
+!REAL_B :: ZTRNCLD(JPGPT+1,JPLAY),ZTAUCLD(JPGPT+1,JPLAY)
+
+INTEGER(KIND=JPIM) :: IBAND, ICLDDN, IENT, INDBOUND, INDEX, IPR, I_LAY, I_LEV, I_NBI
+
+REAL(KIND=JPRB) :: Z_BBD, Z_BBDTOT, Z_BGLAY, Z_CLDSRC, Z_DBDTLAY, Z_DBDTLEV,&
+ & Z_DELBGDN, Z_DELBGUP, Z_DRAD1, Z_DRADCL1, Z_FACTOT1, &
+ & Z_FMAX, Z_FMIN, Z_GASSRC, Z_ODSM, Z_PLANKBND, Z_RADCLD, Z_RADD, Z_RADMOD, Z_RAT1, Z_RAT2, Z_SUMPL, &
+ & Z_SUMPLEM, Z_TBNDFRAC, Z_TRNS, Z_TTOT, Z_URAD1, Z_URADCL1, ZEXTAU  
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+
+
+REAL(KIND=JPRB)                  :: CLFNET(0:JPLAY) ! Argument NOT used
+REAL(KIND=JPRB)                  :: CLHTR(0:JPLAY) ! Argument NOT used
+REAL(KIND=JPRB)                  :: FNET(0:JPLAY) ! Argument NOT used
+REAL(KIND=JPRB)                  :: HTR(0:JPLAY) ! Argument NOT used
+
+
+
+!--------------------------------------------------------------------------
+! Input
+!  JPLAY                 ! Maximum number of model layers
+!  JPGPT                 ! Total number of g-point subintervals
+!  JPBAND                ! Number of longwave spectral bands
+!  SECANG                ! Diffusivity angle
+!  WTNUM                 ! Weight for radiance to flux conversion
+!  KLEV                  ! Number of model layers
+!  PAVEL(JPLAY)          ! Mid-layer pressures (hPa)
+!  PZ(0:JPLAY)           ! Interface pressures (hPa)
+!  TAVEL(JPLAY)          ! Mid-layer temperatures (K)
+!  TZ(0:JPLAY)           ! Interface temperatures (K)
+!  TBOUND                ! Surface temperature
+!  CLDFRAC(JPLAY)        ! Layer cloud fraction
+!  TAUCLD(JPLAY,JPBAND)  ! Layer cloud optical thickness
+!  ITR
+!  PFRAC(JPGPT,JPLAY)    ! Planck function fractions
+!  ICLDLYR(JPLAY)        ! Flag for cloudy layers
+!  ICLD                  ! Flag for cloudy column
+!  IREFLECT              ! Flag for specular reflection
+!  SEMISS(JPBAND)        ! Surface spectral emissivity
+!  BPADE                 ! Pade constant
+!  OD                    ! Clear-sky optical thickness
+!  TAUSF1                ! 
+!  ABSS1                 !  
+
+!  ABSS(JPGPT*JPLAY)     !
+!  ABSCLD(JPLAY)         !
+!  ATOT(JPGPT*JPLAY)     !
+!  ODCLR(JPGPT,JPLAY)    ! 
+!  ODCLD(JPBAND,JPLAY)   !
+!  EFCLFR1(JPBAND,JPLAY) ! Effective cloud fraction
+!  RADLU(JPGPT)          ! Upward radiance
+!  URAD                  ! Spectrally summed upward radiance
+!  RADCLRU(JPGPT)        ! Clear-sky upward radiance
+!  CLRURAD               ! Spectrally summed clear-sky upward radiance
+!  RADLD(JPGPT)          ! Downward radiance
+!  DRAD                  ! Spectrally summed downward radiance
+!  RADCLRD(JPGPT)        ! Clear-sky downward radiance
+!  CLRDRAD               ! Spectrally summed clear-sky downward radiance
+
+! Output
+!  TOTUFLUX(0:JPLAY)     ! Upward longwave flux
+!  TOTDFLUX(0:JPLAY)     ! Downward longwave flux
+!  TOTUFLUC(0:JPLAY)     ! Clear-sky upward longwave flux
+!  TOTDFLUC(0:JPLAY)     ! Clear-sky downward longwave flux
+
+! Maximum/Random cloud overlap variables
+! for upward radiaitve transfer
+!  FACCLR2  fraction of clear radiance from previous layer that needs to 
+!           be switched to cloudy stream
+!  FACCLR1  fraction of the radiance that had been switched in the previous
+!           layer from cloudy to clear that needs to be switched back to
+!           cloudy in the current layer
+!  FACCLD2  fraction of cloudy radiance from previous layer that needs to 
+!           be switched to clear stream
+!           be switched to cloudy stream
+!  FACCLD1  fraction of the radiance that had been switched in the previous
+!           layer from clear to cloudy that needs to be switched back to
+!           clear in the current layer
+! for downward radiaitve transfer
+!  FACCLR2D fraction of clear radiance from previous layer that needs to 
+!           be switched to cloudy stream
+!  FACCLR1D fraction of the radiance that had been switched in the previous
+!           layer from cloudy to clear that needs to be switched back to
+!           cloudy in the current layer
+!  FACCLD2D fraction of cloudy radiance from previous layer that needs to 
+!           be switched to clear stream
+!           be switched to cloudy stream
+!  FACCLD1D fraction of the radiance that had been switched in the previous
+!           layer from clear to cloudy that needs to be switched back to
+!           clear in the current layer
+
+!--------------------------------------------------------------------------
+
+! CORRECTION PROVISOIRE BUG POTENTIEL MPLFH
+! on initialise le niveau klev+1 de p_cldfrac, tableau surdimensionne
+! a 100 mais apparemment non initialise en klev+1
+Z_CLDFRAC(1:KLEV)=P_CLDFRAC(1:KLEV)
+Z_CLDFRAC(KLEV+1)=0.0_JPRB
+IF (LHOOK) CALL DR_HOOK('RRTM_RTRN1A_140GP',0,ZHOOK_HANDLE)
+Z_WTNUM(1)=0.5_JPRB
+Z_WTNUM(2)=0.0_JPRB
+Z_WTNUM(3)=0.0_JPRB
+
+DO I_LAY = 0, KLEV
+ENDDO
+!-start JJM_000511
+IF (P_TBOUND < 339._JPRB .AND. P_TBOUND >= 160._JPRB ) THEN
+  INDBOUND = P_TBOUND - 159._JPRB
+  Z_TBNDFRAC = P_TBOUND - INT(P_TBOUND)
+ELSEIF (P_TBOUND >= 339._JPRB ) THEN
+  INDBOUND = 180
+  Z_TBNDFRAC = P_TBOUND - 339._JPRB
+ELSEIF (P_TBOUND < 160._JPRB ) THEN
+  INDBOUND = 1
+  Z_TBNDFRAC = P_TBOUND - 160._JPRB
+ENDIF  
+!-end JJM_000511
+  
+DO I_LAY = 0, KLEV
+  P_TOTUFLUC(I_LAY) = 0.0_JPRB
+  P_TOTDFLUC(I_LAY) = 0.0_JPRB
+  P_TOTUFLUX(I_LAY) = 0.0_JPRB
+  P_TOTDFLUX(I_LAY) = 0.0_JPRB
+!-start JJM_000511
+  IF (P_TZ(I_LAY) < 339._JPRB .AND. P_TZ(I_LAY) >= 160._JPRB ) THEN
+    INDLEV(I_LAY) = P_TZ(I_LAY) - 159._JPRB
+    Z_TLEVFRAC(I_LAY) = P_TZ(I_LAY) - INT(P_TZ(I_LAY))
+  ELSEIF (P_TZ(I_LAY) >= 339._JPRB ) THEN
+    INDLEV(I_LAY) = 180
+    Z_TLEVFRAC(I_LAY) = P_TZ(I_LAY) - 339._JPRB
+  ELSEIF (P_TZ(I_LAY) < 160._JPRB ) THEN
+    INDLEV(I_LAY) = 1
+    Z_TLEVFRAC(I_LAY) = P_TZ(I_LAY) - 160._JPRB
+  ENDIF    
+!-end JJM_000511
+ENDDO
+
+!_start_jjm 991209
+DO I_LEV=0,KLEV
+  Z_FACCLD1(I_LEV+1) = 0.0_JPRB
+  Z_FACCLD2(I_LEV+1) = 0.0_JPRB
+  Z_FACCLR1(I_LEV+1) = 0.0_JPRB
+  Z_FACCLR2(I_LEV+1) = 0.0_JPRB
+  Z_FACCMB1(I_LEV+1) = 0.0_JPRB
+  Z_FACCMB2(I_LEV+1) = 0.0_JPRB
+  Z_FACCLD1D(I_LEV) = 0.0_JPRB
+  Z_FACCLD2D(I_LEV) = 0.0_JPRB
+  Z_FACCLR1D(I_LEV) = 0.0_JPRB
+  Z_FACCLR2D(I_LEV) = 0.0_JPRB
+  Z_FACCMB1D(I_LEV) = 0.0_JPRB
+  Z_FACCMB2D(I_LEV) = 0.0_JPRB
+ENDDO  
+
+Z_RAT1 = 0.0_JPRB
+Z_RAT2 = 0.0_JPRB
+
+!_end_jjm 991209
+
+Z_SUMPL   = 0.0_JPRB
+Z_SUMPLEM = 0.0_JPRB
+
+ISTCLD(1) = 1
+ISTCLDD(KLEV) = 1
+
+DO I_LEV = 1, KLEV
+!-- DS_000515
+!-start JJM_000511
+  IF (P_TAVEL(I_LEV) < 339._JPRB .AND. P_TAVEL(I_LEV) >= 160._JPRB ) THEN
+    INDLAY(I_LEV) = P_TAVEL(I_LEV) - 159._JPRB
+    Z_TLAYFRAC(I_LEV) = P_TAVEL(I_LEV) - INT(P_TAVEL(I_LEV))
+  ELSEIF (P_TAVEL(I_LEV) >= 339._JPRB ) THEN
+    INDLAY(I_LEV) = 180
+    Z_TLAYFRAC(I_LEV) = P_TAVEL(I_LEV) - 339._JPRB
+  ELSEIF (P_TAVEL(I_LEV) < 160._JPRB ) THEN
+    INDLAY(I_LEV) = 1
+    Z_TLAYFRAC(I_LEV) = P_TAVEL(I_LEV) - 160._JPRB
+  ENDIF  
+!-end JJM_000511
+ENDDO
+!-- DS_000515
+
+!-- DS_000515
+!OCL SCALAR
+
+DO I_LEV = 1, KLEV
+  IF (K_ICLDLYR(I_LEV) == 1) THEN
+
+!mji    
+    ISTCLD(I_LEV+1) = 0
+    IF (I_LEV  ==  KLEV) THEN
+      Z_FACCLD1(I_LEV+1) = 0.0_JPRB
+      Z_FACCLD2(I_LEV+1) = 0.0_JPRB
+      Z_FACCLR1(I_LEV+1) = 0.0_JPRB
+      Z_FACCLR2(I_LEV+1) = 0.0_JPRB
+!-- DS_000515      
+!SB debug >>
+     Z_FACCMB1(I_LEV+1) =0.0_JPRB
+     Z_FACCMB2(I_LEV+1) =0.0_JPRB
+!SB debug <<
+!mji      ISTCLD(LEV+1) = _ZERO_
+    ELSEIF (Z_CLDFRAC(I_LEV+1)  >=  Z_CLDFRAC(I_LEV)) THEN
+      Z_FACCLD1(I_LEV+1) = 0.0_JPRB
+      Z_FACCLD2(I_LEV+1) = 0.0_JPRB
+      IF (ISTCLD(I_LEV)  ==  1) THEN
+!mji        ISTCLD(LEV+1) = 0
+        Z_FACCLR1(I_LEV+1) = 0.0_JPRB
+!mji        
+        Z_FACCLR2(I_LEV+1) = 0.0_JPRB
+        IF (Z_CLDFRAC(I_LEV) < 1.0_JPRB) THEN
+          Z_FACCLR2(I_LEV+1) = (Z_CLDFRAC(I_LEV+1)-Z_CLDFRAC(I_LEV))/&
+           & (1.0_JPRB-Z_CLDFRAC(I_LEV))  
+        ENDIF  
+!SB debug >>
+      Z_FACCLR2(I_LEV) = 0.0_JPRB
+      Z_FACCLD2(I_LEV) = 0.0_JPRB
+!SB debug <<
+      ELSE
+        Z_FMAX = MAX(Z_CLDFRAC(I_LEV),Z_CLDFRAC(I_LEV-1))
+!mji
+        IF (Z_CLDFRAC(I_LEV+1)  >  Z_FMAX) THEN
+          Z_FACCLR1(I_LEV+1) = Z_RAT2
+          Z_FACCLR2(I_LEV+1) = (Z_CLDFRAC(I_LEV+1)-Z_FMAX)/(1.0_JPRB-Z_FMAX)
+!mji          
+        ELSEIF (Z_CLDFRAC(I_LEV+1) < Z_FMAX) THEN
+          Z_FACCLR1(I_LEV+1) = (Z_CLDFRAC(I_LEV+1)-Z_CLDFRAC(I_LEV))/&
+           & (Z_CLDFRAC(I_LEV-1)-Z_CLDFRAC(I_LEV))  
+          Z_FACCLR2(I_LEV+1) = 0.0_JPRB
+!mji
+        ELSE
+          Z_FACCLR1(I_LEV+1) = Z_RAT2  
+          Z_FACCLR2(I_LEV+1) = 0.0_JPRB
+        ENDIF
+      ENDIF
+      IF (Z_FACCLR1(I_LEV+1) > 0.0_JPRB .OR. Z_FACCLR2(I_LEV+1) > 0.0_JPRB) THEN
+        Z_RAT1 = 1.0_JPRB
+        Z_RAT2 = 0.0_JPRB
+!SB debug >>
+!      ENDIF
+      ELSE
+        Z_RAT1 = 0.0_JPRB
+        Z_RAT2 = 0.0_JPRB
+      ENDIF
+!SB debug <<
+    ELSE
+      Z_FACCLR1(I_LEV+1) = 0.0_JPRB
+      Z_FACCLR2(I_LEV+1) = 0.0_JPRB
+      IF (ISTCLD(I_LEV)  ==  1) THEN
+!mji        ISTCLD(LEV+1) = 0
+        Z_FACCLD1(I_LEV+1) = 0.0_JPRB
+        Z_FACCLD2(I_LEV+1) = (Z_CLDFRAC(I_LEV)-Z_CLDFRAC(I_LEV+1))/Z_CLDFRAC(I_LEV)
+!SB debug >>
+        Z_FACCLR2(I_LEV) = 0.0_JPRB
+        Z_FACCLD2(I_LEV) = 0.0_JPRB
+!SB debug <<
+      ELSE
+        Z_FMIN = MIN(Z_CLDFRAC(I_LEV),Z_CLDFRAC(I_LEV-1))
+        IF (Z_CLDFRAC(I_LEV+1)  <=  Z_FMIN) THEN
+          Z_FACCLD1(I_LEV+1) = Z_RAT1
+          Z_FACCLD2(I_LEV+1) = (Z_FMIN-Z_CLDFRAC(I_LEV+1))/Z_FMIN
+        ELSE
+          Z_FACCLD1(I_LEV+1) = (Z_CLDFRAC(I_LEV)-Z_CLDFRAC(I_LEV+1))/&
+           & (Z_CLDFRAC(I_LEV)-Z_FMIN)  
+          Z_FACCLD2(I_LEV+1) = 0.0_JPRB
+        ENDIF
+      ENDIF
+      IF (Z_FACCLD1(I_LEV+1) > 0.0_JPRB .OR. Z_FACCLD2(I_LEV+1) > 0.0_JPRB) THEN
+        Z_RAT1 = 0.0_JPRB
+        Z_RAT2 = 1.0_JPRB
+!SB debug >>
+!      ENDIF
+      ELSE 
+        Z_RAT1 = 0.0_JPRB
+        Z_RAT2 = 0.0_JPRB
+      ENDIF
+!SB debug <<
+    ENDIF
+!fcc
+
+!SB debug >>
+!    IF (I_LEV == 1) THEN
+!      Z_FACCMB1(I_LEV+1) = 0.
+!      Z_FACCMB2(I_LEV+1) = Z_FACCLD1(I_LEV+1) * Z_FACCLR2(I_LEV)
+!    ELSE
+!      Z_FACCMB1(I_LEV+1) = Z_FACCLR1(I_LEV+1) * Z_FACCLD2(I_LEV) *Z_CLDFRAC(I_LEV-1)
+!      Z_FACCMB2(I_LEV+1) = Z_FACCLD1(I_LEV+1) * Z_FACCLR2(I_LEV) *&
+!       & (1.0_JPRB - Z_CLDFRAC(I_LEV-1))   
+!    ENDIF
+     if(istcld(i_lev).ne.1.and.i_lev.ne.1) then
+        z_faccmb1(i_lev+1) = max(0.,min(z_cldfrac(i_lev+1)-z_cldfrac(i_lev), &
+               z_cldfrac(i_lev-1)-z_cldfrac(i_lev)))
+        z_faccmb2(i_lev+1) = max(0.,min(z_cldfrac(i_lev)-z_cldfrac(i_lev+1), &
+               z_cldfrac(i_lev)-z_cldfrac(i_lev-1)))
+     endif
+!SB debug <<
+!end fcc
+  ELSE
+!-- DS_000515
+    ISTCLD(I_LEV+1) = 1
+  ENDIF
+ENDDO
+
+!_start_jjm 991209
+Z_RAT1 = 0.0_JPRB
+Z_RAT2 = 0.0_JPRB
+!_end_jjm 991209
+
+!-- DS_000515
+!OCL SCALAR
+
+DO I_LEV = KLEV, 1, -1
+  IF (K_ICLDLYR(I_LEV) == 1) THEN
+!mji
+    ISTCLDD(I_LEV-1) = 0  
+    IF (I_LEV  ==  1) THEN
+      Z_FACCLD1D(I_LEV-1) = 0.0_JPRB
+      Z_FACCLD2D(I_LEV-1) = 0.0_JPRB
+      Z_FACCLR1D(I_LEV-1) = 0.0_JPRB
+      Z_FACCLR2D(I_LEV-1) = 0.0_JPRB
+      Z_FACCMB1D(I_LEV-1) = 0.0_JPRB
+      Z_FACCMB2D(I_LEV-1) = 0.0_JPRB
+!mji      ISTCLDD(LEV-1) = _ZERO_
+    ELSEIF (Z_CLDFRAC(I_LEV-1)  >=  Z_CLDFRAC(I_LEV)) THEN
+      Z_FACCLD1D(I_LEV-1) = 0.0_JPRB
+      Z_FACCLD2D(I_LEV-1) = 0.0_JPRB
+      IF (ISTCLDD(I_LEV)  ==  1) THEN
+!mji        ISTCLDD(LEV-1) = 0
+        Z_FACCLR1D(I_LEV-1) = 0.0_JPRB
+        Z_FACCLR2D(I_LEV-1) = 0.0_JPRB
+        IF (Z_CLDFRAC(I_LEV) < 1.0_JPRB) THEN
+          Z_FACCLR2D(I_LEV-1) = (Z_CLDFRAC(I_LEV-1)-Z_CLDFRAC(I_LEV))/&
+           & (1.0_JPRB-Z_CLDFRAC(I_LEV))  
+        ENDIF
+!SB debug >>
+       z_facclr2d(i_lev)=0.0_JPRB        
+       z_faccld2d(i_lev)=0.0_JPRB
+!SB debug <<
+      ELSE
+        Z_FMAX = MAX(Z_CLDFRAC(I_LEV),Z_CLDFRAC(I_LEV+1))
+!mji
+        IF (Z_CLDFRAC(I_LEV-1)  >  Z_FMAX) THEN
+          Z_FACCLR1D(I_LEV-1) = Z_RAT2
+          Z_FACCLR2D(I_LEV-1) = (Z_CLDFRAC(I_LEV-1)-Z_FMAX)/(1.0_JPRB-Z_FMAX)
+!mji
+        ELSEIF (Z_CLDFRAC(I_LEV-1) < Z_FMAX) THEN
+          Z_FACCLR1D(I_LEV-1) = (Z_CLDFRAC(I_LEV-1)-Z_CLDFRAC(I_LEV))/&
+           & (Z_CLDFRAC(I_LEV+1)-Z_CLDFRAC(I_LEV))  
+          Z_FACCLR2D(I_LEV-1) = 0.0_JPRB
+!mji
+        ELSE          
+          Z_FACCLR1D(I_LEV-1) = Z_RAT2
+          Z_FACCLR2D(I_LEV-1) = 0.0_JPRB
+        ENDIF
+      ENDIF
+      IF (Z_FACCLR1D(I_LEV-1) > 0.0_JPRB .OR. Z_FACCLR2D(I_LEV-1) > 0.0_JPRB)THEN
+        Z_RAT1 = 1.0_JPRB
+        Z_RAT2 = 0.0_JPRB
+!SB debug >>
+!      ENDIF
+      else 
+        Z_RAT1 = 0.0_JPRB
+        Z_RAT2 = 0.0_JPRB
+      endif       
+!SB debug <<
+    ELSE
+      Z_FACCLR1D(I_LEV-1) = 0.0_JPRB
+      Z_FACCLR2D(I_LEV-1) = 0.0_JPRB
+      IF (ISTCLDD(I_LEV)  ==  1) THEN
+!mji        ISTCLDD(LEV-1) = 0
+        Z_FACCLD1D(I_LEV-1) = 0.0_JPRB
+        Z_FACCLD2D(I_LEV-1) = (Z_CLDFRAC(I_LEV)-Z_CLDFRAC(I_LEV-1))/Z_CLDFRAC(I_LEV)
+!SB debug >>
+        z_facclr2d(i_lev)=0.0_JPRB
+        z_faccld2d(i_lev)=0.0_JPRB
+!SB debug <<
+      ELSE
+        Z_FMIN = MIN(Z_CLDFRAC(I_LEV),Z_CLDFRAC(I_LEV+1))
+        IF (Z_CLDFRAC(I_LEV-1)  <=  Z_FMIN) THEN
+          Z_FACCLD1D(I_LEV-1) = Z_RAT1
+          Z_FACCLD2D(I_LEV-1) = (Z_FMIN-Z_CLDFRAC(I_LEV-1))/Z_FMIN
+        ELSE
+          Z_FACCLD1D(I_LEV-1) = (Z_CLDFRAC(I_LEV)-Z_CLDFRAC(I_LEV-1))/&
+           & (Z_CLDFRAC(I_LEV)-Z_FMIN)  
+          Z_FACCLD2D(I_LEV-1) = 0.0_JPRB
+        ENDIF
+      ENDIF
+      IF (Z_FACCLD1D(I_LEV-1) > 0.0_JPRB .OR. Z_FACCLD2D(I_LEV-1) > 0.0_JPRB)THEN
+        Z_RAT1 = 0.0_JPRB
+        Z_RAT2 = 1.0_JPRB
+!SB debug >>
+!      ENDIF
+      ELSE
+        Z_RAT1 = 0.0_JPRB
+        Z_RAT2 = 0.0_JPRB
+      ENDIF
+!SB debug <<
+    ENDIF
+!SB debug >>
+!    Z_FACCMB1D(I_LEV-1) = Z_FACCLR1D(I_LEV-1) * Z_FACCLD2D(I_LEV) *Z_CLDFRAC(I_LEV+1)
+!    Z_FACCMB2D(I_LEV-1) = Z_FACCLD1D(I_LEV-1) * Z_FACCLR2D(I_LEV) *&
+!     & (1.0_JPRB - Z_CLDFRAC(I_LEV+1))  
+    if (istcldd(i_lev).ne.1.and.i_lev.ne.1) then
+       z_faccmb1d(i_lev-1) = max(0.,min(z_cldfrac(i_lev+1)-z_cldfrac(i_lev), &
+                            z_cldfrac(i_lev-1)-z_cldfrac(i_lev)))
+       z_faccmb2d(i_lev-1) = max(0.,min(z_cldfrac(i_lev)-z_cldfrac(i_lev+1), &
+                    z_cldfrac(i_lev)-z_cldfrac(i_lev-1)))
+    endif
+!SB debug <<
+  ELSE
+    ISTCLDD(I_LEV-1) = 1
+  ENDIF
+ENDDO
+
+!- Loop over frequency bands.
+
+DO IBAND = K_ISTART, K_IEND
+  Z_DBDTLEV = TOTPLNK(INDBOUND+1,IBAND)-TOTPLNK(INDBOUND,IBAND)
+  Z_PLANKBND = DELWAVE(IBAND) * (TOTPLNK(INDBOUND,IBAND) + Z_TBNDFRAC * Z_DBDTLEV)
+  Z_DBDTLEV = TOTPLNK(INDLEV(0)+1,IBAND) -TOTPLNK(INDLEV(0),IBAND)
+!-- DS_000515
+  Z_PLVL(IBAND,0) = DELWAVE(IBAND)&
+   & * (TOTPLNK(INDLEV(0),IBAND) + Z_TLEVFRAC(0)*Z_DBDTLEV)  
+
+  Z_SURFEMIS(IBAND) = P_SEMISS(IBAND)
+  Z_PLNKEMIT(IBAND) = Z_SURFEMIS(IBAND) * Z_PLANKBND
+  Z_SUMPLEM  = Z_SUMPLEM + Z_PLNKEMIT(IBAND)
+  Z_SUMPL    = Z_SUMPL   + Z_PLANKBND
+!--DS
+ENDDO
+!---
+
+!-- DS_000515
+DO I_LEV = 1, KLEV
+  DO IBAND = K_ISTART, K_IEND
+! print *,'RTRN1A: I_LEV JPLAY IBAND INDLAY',I_LEV,JPLAY,IBAND,INDLAY(I_LEV)
+!----              
+!- Calculate the integrated Planck functions for at the
+!  level and layer temperatures.
+!  Compute cloud transmittance for cloudy layers.
+    Z_DBDTLEV = TOTPLNK(INDLEV(I_LEV)+1,IBAND) - TOTPLNK(INDLEV(I_LEV),IBAND)
+    Z_DBDTLAY = TOTPLNK(INDLAY(I_LEV)+1,IBAND) - TOTPLNK(INDLAY(I_LEV),IBAND)
+!-- DS_000515
+    Z_PLAY(IBAND,I_LEV) = DELWAVE(IBAND)&
+     & *(TOTPLNK(INDLAY(I_LEV),IBAND)+Z_TLAYFRAC(I_LEV)*Z_DBDTLAY)  
+    Z_PLVL(IBAND,I_LEV) = DELWAVE(IBAND)&
+     & *(TOTPLNK(INDLEV(I_LEV),IBAND)+Z_TLEVFRAC(I_LEV)*Z_DBDTLEV)  
+    IF (K_ICLDLYR(I_LEV) > 0) THEN
+      ZEXTAU = MIN( P_TAUCLD(I_LEV,IBAND), 200._JPRB)
+      Z_TRNCLD(I_LEV,IBAND) = EXP( -ZEXTAU )
+    ENDIF
+!-- DS_000515
+  ENDDO
+
+ENDDO
+
+P_SEMISLW = Z_SUMPLEM / Z_SUMPL
+
+!--DS
+!O IPR = 1, JPGPT
+! NBI = NGB(IPR)
+! DO LEV =  1 , KLEV
+!-- DS_000515
+!   ZPLAY(IPR,LEV) = PLAY(LEV,NGB(IPR))
+!   ZPLVL(IPR,LEV) = PLVL(LEV-1,NGB(IPR))
+!   ZTAUCLD(IPR,LEV) = TAUCLD(LEV,NGB(IPR))
+!   ZTRNCLD(IPR,LEV) = TRNCLD(LEV,NGB(IPR))
+!-- DS_000515
+! ENDDO
+!NDDO
+!----      
+
+!- For cloudy layers, set cloud parameters for radiative transfer.
+DO I_LEV = 1, KLEV
+  IF (K_ICLDLYR(I_LEV) > 0) THEN
+    DO IPR = 1, JPGPT
+!--DS          
+!            NBI = NGB(IPR)
+      Z_ODCLDNW(IPR,I_LEV) = P_TAUCLD(I_LEV,NGB(IPR))
+      Z_ABSCLDNW(IPR,I_LEV) = 1.0_JPRB - Z_TRNCLD(I_LEV,NGB(IPR))
+!----            
+!            EFCLFRNW(IPR,LEV) = ABSCLDNW(IPR,LEV) * CLDFRAC(LEV)
+    ENDDO
+  ENDIF
+ENDDO
+
+!- Initialize for radiative transfer.
+DO IPR = 1, JPGPT
+  Z_RADCLRD1(IPR) = 0.0_JPRB
+  Z_RADLD1(IPR)   = 0.0_JPRB
+  I_NBI = NGB(IPR)
+  Z_SEMIS(IPR) = Z_SURFEMIS(I_NBI)
+  Z_RADUEMIT(IPR) = PFRAC(IPR,1) * Z_PLNKEMIT(I_NBI)
+!-- DS_000515
+  Z_BGLEV(IPR) = PFRAC(IPR,KLEV) * Z_PLVL(I_NBI,KLEV)
+ENDDO
+
+!- Downward radiative transfer.
+!  *** DRAD1 holds summed radiance for total sky stream
+!  *** DRADCL1 holds summed radiance for clear sky stream
+
+ICLDDN = 0
+DO I_LEV = KLEV, 1, -1
+  Z_DRAD1   = 0.0_JPRB
+  Z_DRADCL1 = 0.0_JPRB
+
+  IF (K_ICLDLYR(I_LEV) == 1) THEN
+
+!  *** Cloudy layer
+    ICLDDN = 1
+    IENT = JPGPT * (I_LEV-1)
+    DO IPR = 1, JPGPT
+      INDEX = IENT + IPR
+!--DS            
+!            NBI = NGB(IPR)
+      Z_BGLAY = PFRAC(IPR,I_LEV) * Z_PLAY(NGB(IPR),I_LEV)
+!----            
+      Z_DELBGUP     = Z_BGLEV(IPR) - Z_BGLAY
+      Z_BBU1(INDEX) = Z_BGLAY + P_TAUSF1(INDEX) * Z_DELBGUP
+!--DS            
+      Z_BGLEV(IPR) = PFRAC(IPR,I_LEV) * Z_PLVL(NGB(IPR),I_LEV-1)
+!----            
+      Z_DELBGDN = Z_BGLEV(IPR) - Z_BGLAY
+      Z_BBD = Z_BGLAY + P_TAUSF1(INDEX) * Z_DELBGDN
+!- total-sky downward flux          
+      Z_ODSM = P_OD(IPR,I_LEV) + Z_ODCLDNW(IPR,I_LEV)
+      Z_FACTOT1 = Z_ODSM / (BPADE + Z_ODSM)
+      Z_BBUTOT1(INDEX) = Z_BGLAY + Z_FACTOT1 * Z_DELBGUP
+      Z_ATOT1(INDEX) = P_ABSS1(INDEX) + Z_ABSCLDNW(IPR,I_LEV)&
+       & - P_ABSS1(INDEX) * Z_ABSCLDNW(IPR,I_LEV)  
+      Z_BBDTOT = Z_BGLAY + Z_FACTOT1 * Z_DELBGDN
+      Z_GASSRC = Z_BBD * P_ABSS1(INDEX)
+!***
+      IF (ISTCLDD(I_LEV)  ==  1) THEN
+        Z_CLDRADD(IPR) = Z_CLDFRAC(I_LEV) * Z_RADLD1(IPR)
+        Z_CLRRADD(IPR) = Z_RADLD1(IPR) - Z_CLDRADD(IPR)
+        Z_OLDCLD(IPR) = Z_CLDRADD(IPR)
+        Z_OLDCLR(IPR) = Z_CLRRADD(IPR)
+        Z_RAD(IPR) = 0.0_JPRB
+      ENDIF
+      Z_TTOT = 1.0_JPRB - Z_ATOT1(INDEX)
+      Z_CLDSRC = Z_BBDTOT * Z_ATOT1(INDEX)
+      
+! Separate RT equations for clear and cloudy streams      
+      Z_CLDRADD(IPR) = Z_CLDRADD(IPR) * Z_TTOT + Z_CLDFRAC(I_LEV) * Z_CLDSRC
+      Z_CLRRADD(IPR) = Z_CLRRADD(IPR) * (1.0_JPRB-P_ABSS1(INDEX)) +&
+       & (1.0_JPRB - Z_CLDFRAC(I_LEV)) * Z_GASSRC  
+
+!  Total sky downward radiance
+      Z_RADLD1(IPR) = Z_CLDRADD(IPR) + Z_CLRRADD(IPR)
+      Z_DRAD1 = Z_DRAD1 + Z_RADLD1(IPR)
+      
+!  Clear-sky downward radiance          
+      Z_RADCLRD1(IPR) = Z_RADCLRD1(IPR)+(Z_BBD-Z_RADCLRD1(IPR))*P_ABSS1(INDEX)
+      Z_DRADCL1 = Z_DRADCL1 + Z_RADCLRD1(IPR)
+
+!* Code to account for maximum/random overlap:
+!   Performs RT on the radiance most recently switched between clear and
+!   cloudy streams
+      Z_RADMOD = Z_RAD(IPR) * (Z_FACCLR1D(I_LEV-1) * (1.0_JPRB-P_ABSS1(INDEX)) +&
+       & Z_FACCLD1D(I_LEV-1) *  Z_TTOT) - &
+       & Z_FACCMB1D(I_LEV-1) * Z_GASSRC + &
+       & Z_FACCMB2D(I_LEV-1) * Z_CLDSRC  
+       
+!   Computes what the clear and cloudy streams would have been had no
+!   radiance been switched       
+      Z_OLDCLD(IPR) = Z_CLDRADD(IPR) - Z_RADMOD
+      Z_OLDCLR(IPR) = Z_CLRRADD(IPR) + Z_RADMOD
+      
+!   Computes the radiance to be switched between clear and cloudy.      
+      Z_RAD(IPR) = -Z_RADMOD + Z_FACCLR2D(I_LEV-1)*Z_OLDCLR(IPR) -&
+       & Z_FACCLD2D(I_LEV-1)*Z_OLDCLD(IPR)  
+      Z_CLDRADD(IPR) = Z_CLDRADD(IPR) + Z_RAD(IPR)
+      Z_CLRRADD(IPR) = Z_CLRRADD(IPR) - Z_RAD(IPR)
+!***
+
+    ENDDO
+
+  ELSE
+
+!  *** Clear layer
+!  *** DRAD1 holds summed radiance for total sky stream
+!  *** DRADCL1 holds summed radiance for clear sky stream
+
+    IENT = JPGPT * (I_LEV-1)
+    IF (ICLDDN == 1) THEN
+      DO IPR = 1, JPGPT
+        INDEX = IENT + IPR
+!--DS         
+!           NBI = NGB(IPR)
+        Z_BGLAY = PFRAC(IPR,I_LEV) * Z_PLAY(NGB(IPR),I_LEV)
+!----            
+        Z_DELBGUP     = Z_BGLEV(IPR) - Z_BGLAY
+        Z_BBU1(INDEX) = Z_BGLAY + P_TAUSF1(INDEX) * Z_DELBGUP
+!--DS            
+        Z_BGLEV(IPR) = PFRAC(IPR,I_LEV) * Z_PLVL(NGB(IPR),I_LEV-1)
+!----                      
+        Z_DELBGDN = Z_BGLEV(IPR) - Z_BGLAY
+        Z_BBD = Z_BGLAY + P_TAUSF1(INDEX) * Z_DELBGDN
+        
+!- total-sky downward radiance
+        Z_RADLD1(IPR) = Z_RADLD1(IPR)+(Z_BBD-Z_RADLD1(IPR))*P_ABSS1(INDEX)
+        Z_DRAD1 = Z_DRAD1 + Z_RADLD1(IPR)
+        
+!- clear-sky downward radiance
+!-  Set clear sky stream to total sky stream as long as layers
+!-  remain clear.  Streams diverge when a cloud is reached.
+        Z_RADCLRD1(IPR) = Z_RADCLRD1(IPR)+(Z_BBD-Z_RADCLRD1(IPR))*P_ABSS1(INDEX)
+        Z_DRADCL1 = Z_DRADCL1 + Z_RADCLRD1(IPR)
+      ENDDO
+            
+    ELSE
+        
+      DO IPR = 1, JPGPT
+        INDEX = IENT + IPR
+!--DS         
+!           NBI = NGB(IPR)
+        Z_BGLAY = PFRAC(IPR,I_LEV) * Z_PLAY(NGB(IPR),I_LEV)
+!----            
+        Z_DELBGUP     = Z_BGLEV(IPR) - Z_BGLAY
+        Z_BBU1(INDEX) = Z_BGLAY + P_TAUSF1(INDEX) * Z_DELBGUP
+!--DS            
+        Z_BGLEV(IPR) = PFRAC(IPR,I_LEV) * Z_PLVL(NGB(IPR),I_LEV-1)
+!----                      
+        Z_DELBGDN = Z_BGLEV(IPR) - Z_BGLAY
+        Z_BBD = Z_BGLAY + P_TAUSF1(INDEX) * Z_DELBGDN
+!- total-sky downward flux          
+        Z_RADLD1(IPR) = Z_RADLD1(IPR)+(Z_BBD-Z_RADLD1(IPR))*P_ABSS1(INDEX)
+        Z_DRAD1 = Z_DRAD1 + Z_RADLD1(IPR)
+!- clear-sky downward flux          
+!-  Set clear sky stream to total sky stream as long as layers
+!-  remain clear.  Streams diverge when a cloud is reached.
+        Z_RADCLRD1(IPR) = Z_RADLD1(IPR)
+      ENDDO
+      Z_DRADCL1 = Z_DRAD1
+    ENDIF
+    
+  ENDIF
+
+  P_TOTDFLUC(I_LEV-1) = Z_DRADCL1 * Z_WTNUM(1)
+  P_TOTDFLUX(I_LEV-1) = Z_DRAD1   * Z_WTNUM(1)
+
+ENDDO
+
+! Spectral reflectivity and reflectance
+! Includes the contribution of spectrally varying longwave emissivity 
+! and reflection from the surface to the upward radiative transfer.
+! Note: Spectral and Lambertian reflections are identical for the one
+! angle flux integration used here.
+
+Z_URAD1   = 0.0_JPRB
+Z_URADCL1 = 0.0_JPRB
+
+!start JJM_000511
+!IF (IREFLECT  ==  0) THEN
+!- Lambertian reflection.
+DO IPR = 1, JPGPT
+! Clear-sky radiance
+!    RADCLD = _TWO_ * (RADCLRD1(IPR) * WTNUM(1) )
+  Z_RADCLD = Z_RADCLRD1(IPR)
+  Z_RADCLRU1(IPR) = Z_RADUEMIT(IPR) + (1.0_JPRB - Z_SEMIS(IPR)) * Z_RADCLD
+  Z_URADCL1 = Z_URADCL1 + Z_RADCLRU1(IPR)
+
+! Total sky radiance
+!    RADD = _TWO_ * (RADLD1(IPR) * WTNUM(1) )
+  Z_RADD = Z_RADLD1(IPR)
+  Z_RADLU1(IPR) = Z_RADUEMIT(IPR) + (1.0_JPRB - Z_SEMIS(IPR)) * Z_RADD
+  Z_URAD1 = Z_URAD1 + Z_RADLU1(IPR)
+ENDDO
+P_TOTUFLUC(0) = Z_URADCL1 * 0.5_JPRB
+P_TOTUFLUX(0) = Z_URAD1 * 0.5_JPRB
+!ELSE
+!!- Specular reflection.
+!  DO IPR = 1, JPGPT
+!    RADCLU = RADUEMIT(IPR)
+!    RADCLRU1(IPR) = RADCLU + (_ONE_ - SEMIS(IPR)) * RADCLRD1(IPR)
+!    URADCL1 = URADCL1 + RADCLRU1(IPR)
+
+!    RADU = RADUEMIT(IPR)
+!    RADLU1(IPR) = RADU + (_ONE_ - SEMIS(IPR)) * RADLD1(IPR)
+!    URAD1 = URAD1 + RADLU1(IPR)
+!  ENDDO
+!  TOTUFLUC(0) = URADCL1 * WTNUM(1)
+!  TOTUFLUX(0) = URAD1   * WTNUM(1)
+!ENDIF
+
+!- Upward radiative transfer.
+!- *** URAD1 holds the summed radiance for total sky stream
+!- *** URADCL1 holds the summed radiance for clear sky stream
+DO I_LEV = 1, KLEV
+  Z_URAD1   = 0.0_JPRB
+  Z_URADCL1 = 0.0_JPRB
+
+! Check flag for cloud in current layer
+  IF (K_ICLDLYR(I_LEV) == 1) THEN
+
+!- *** Cloudy layer
+    IENT = JPGPT * (I_LEV-1)
+    DO IPR = 1, JPGPT
+      INDEX = IENT + IPR
+!- total-sky upward flux          
+      Z_GASSRC = Z_BBU1(INDEX) * P_ABSS1(INDEX)
+
+!- If first cloudy layer in sequence, split up radiance into clear and
+!    cloudy streams depending on cloud fraction
+      IF (ISTCLD(I_LEV)  ==  1) THEN
+        Z_CLDRADU(IPR) = Z_CLDFRAC(I_LEV) * Z_RADLU1(IPR)
+        Z_CLRRADU(IPR) = Z_RADLU1(IPR) - Z_CLDRADU(IPR)
+        Z_OLDCLD(IPR) = Z_CLDRADU(IPR)
+        Z_OLDCLR(IPR) = Z_CLRRADU(IPR)
+        Z_RAD(IPR) = 0.0_JPRB
+      ENDIF
+      Z_TTOT = 1.0_JPRB - Z_ATOT1(INDEX)
+      Z_TRNS = 1.0_JPRB - P_ABSS1(INDEX)
+      Z_CLDSRC = Z_BBUTOT1(INDEX) * Z_ATOT1(INDEX)
+
+!- Separate RT equations for clear and cloudy streams      
+      Z_CLDRADU(IPR) = Z_CLDRADU(IPR) * Z_TTOT + Z_CLDFRAC(I_LEV) * Z_CLDSRC
+      Z_CLRRADU(IPR) = Z_CLRRADU(IPR) * Z_TRNS +(1.0_JPRB - Z_CLDFRAC(I_LEV)) * Z_GASSRC
+!***
+
+!- total sky upward flux
+      Z_RADLU1(IPR) = Z_CLDRADU(IPR) + Z_CLRRADU(IPR)
+      Z_URAD1 = Z_URAD1 + Z_RADLU1(IPR)
+      
+!- clear-sky upward flux
+      Z_RADCLRU1(IPR) = Z_RADCLRU1(IPR) + (Z_BBU1(INDEX)-Z_RADCLRU1(IPR))&
+       & *P_ABSS1(INDEX)  
+      Z_URADCL1 = Z_URADCL1 + Z_RADCLRU1(IPR)
+
+!* Code to account for maximum/random overlap:
+!   Performs RT on the radiance most recently switched between clear and
+!   cloudy streams
+      Z_RADMOD = Z_RAD(IPR) * (Z_FACCLR1(I_LEV+1) * Z_TRNS +&
+       & Z_FACCLD1(I_LEV+1) *  Z_TTOT) - &
+       & Z_FACCMB1(I_LEV+1) * Z_GASSRC + &
+       & Z_FACCMB2(I_LEV+1) * Z_CLDSRC  
+       
+!   Computes what the clear and cloudy streams would have been had no
+!   radiance been switched       
+      Z_OLDCLD(IPR) = Z_CLDRADU(IPR) - Z_RADMOD
+      Z_OLDCLR(IPR) = Z_CLRRADU(IPR) + Z_RADMOD
+      
+!   Computes the radiance to be switched between clear and cloudy.      
+      Z_RAD(IPR) = -Z_RADMOD + Z_FACCLR2(I_LEV+1)*Z_OLDCLR(IPR) -&
+       & Z_FACCLD2(I_LEV+1)*Z_OLDCLD(IPR)  
+      Z_CLDRADU(IPR) = Z_CLDRADU(IPR) + Z_RAD(IPR)
+      Z_CLRRADU(IPR) = Z_CLRRADU(IPR) - Z_RAD(IPR)
+!***
+    ENDDO
+
+  ELSE
+
+!- *** Clear layer
+    IENT = JPGPT * (I_LEV-1)
+    DO IPR = 1, JPGPT
+      INDEX = IENT + IPR
+!- total-sky upward flux          
+      Z_RADLU1(IPR) = Z_RADLU1(IPR)+(Z_BBU1(INDEX)-Z_RADLU1(IPR))*P_ABSS1(INDEX)
+      Z_URAD1 = Z_URAD1 + Z_RADLU1(IPR)
+!- clear-sky upward flux
+!   Upward clear and total sky streams must be separate because surface
+!   reflectance is different for each.
+      Z_RADCLRU1(IPR) = Z_RADCLRU1(IPR)+(Z_BBU1(INDEX)-Z_RADCLRU1(IPR))*P_ABSS1(INDEX)
+      Z_URADCL1 = Z_URADCL1 + Z_RADCLRU1(IPR)
+    ENDDO
+
+  ENDIF
+
+  P_TOTUFLUC(I_LEV) = Z_URADCL1 * Z_WTNUM(1)
+  P_TOTUFLUX(I_LEV) = Z_URAD1   * Z_WTNUM(1)
+
+ENDDO
+
+!* Convert radiances to fluxes and heating rates for total and clear sky.
+! ** NB: moved to calling routine
+!      TOTUFLUC(0) = TOTUFLUC(0) * FLUXFAC
+!      TOTDFLUC(0) = TOTDFLUC(0) * FLUXFAC
+!      TOTUFLUX(0) = TOTUFLUX(0) * FLUXFAC
+!      TOTDFLUX(0) = TOTDFLUX(0) * FLUXFAC
+
+!      CLFNET(0) = (P_TOTUFLUC(0) - P_TOTDFLUC(0))
+!      FNET(0)   = (P_TOTUFLUX(0) - P_TOTDFLUX(0))
+!      DO LEV = 1, KLEV
+!        TOTUFLUC(LEV) = TOTUFLUC(LEV) * FLUXFAC
+!        TOTDFLUC(LEV) = TOTDFLUC(LEV) * FLUXFAC
+!         CLFNET(LEV) =(P_TOTUFLUC(LEV) - P_TOTDFLUC(LEV))
+
+!        TOTUFLUX(LEV) = TOTUFLUX(LEV) * FLUXFAC
+!        TOTDFLUX(LEV) = TOTDFLUX(LEV) * FLUXFAC
+!        FNET(LEV) = (P_TOTUFLUX(LEV) - P_TOTDFLUX(LEV))
+!        L = LEV - 1
+
+!- Calculate Heating Rates.
+!        CLHTR(L)=HEATFAC*(CLFNET(L)-CLFNET(LEV))/(PZ(L)-PZ(LEV)) 
+!        HTR(L)  =HEATFAC*(FNET(L)  -FNET(LEV))  /(PZ(L)-PZ(LEV)) 
+!      END DO
+!      CLHTR(KLEV) = 0.0
+!      HTR(KLEV)   = 0.0
+
+
+
+IF (LHOOK) CALL DR_HOOK('RRTM_RTRN1A_140GP',1,ZHOOK_HANDLE)
+END SUBROUTINE RRTM_RTRN1A_140GP
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/rrtm_taumol1.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/rrtm_taumol1.F90	(revision 5133)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/rrtm_taumol1.F90	(revision 5133)
@@ -0,0 +1,241 @@
+!******************************************************************************
+!                                                                             *
+!                  Optical depths developed for the                           *
+!                                                                             *
+!                RAPID RADIATIVE TRANSFER MODEL (RRTM)                        *
+!                                                                             *
+!            ATMOSPHERIC AND ENVIRONMENTAL RESEARCH, INC.                     *
+!                        840 MEMORIAL DRIVE                                   *
+!                        CAMBRIDGE, MA 02139                                  *
+!                                                                             *
+!                           ELI J. MLAWER                                     *
+!                         STEVEN J. TAUBMAN                                   *
+!                         SHEPARD A. CLOUGH                                   *
+!                                                                             *
+!                       email:  mlawer@aer.com                                *
+!                                                                             *
+!        The authors wish to acknowledge the contributions of the             *
+!        following people:  Patrick D. Brown, Michael J. Iacono,              *
+!        Ronald E. Farren, Luke Chen, Robert Bergstrom.                       *
+!                                                                             *
+!******************************************************************************
+! Modified by:                                                                *
+!      JJ Morcrette 980714 ECMWF      for use on ECMWF's Fujitsu VPP770       *
+!         Reformatted for F90 by JJMorcrette, ECMWF                           * 
+!         - replacing COMMONs by MODULEs                                      *
+!         - changing labelled to unlabelled DO loops                          *
+!         - creating set-up routines for all block data statements            *
+!         - reorganizing the parameter statements                             * 
+!         - passing KLEV as argument                                          *
+!         - suppressing some equivalencing                                    *
+!                                                                             *
+!      D Salmond    9907   ECMWF      Speed-up modifications                  *
+!      D Salmond    000515 ECMWF      Speed-up modifications                  *
+!******************************************************************************
+!     TAUMOL                                                                  *
+!                                                                             *
+!     This file contains the subroutines TAUGBn (where n goes from            *
+!     1 to 16).  TAUGBn calculates the optical depths and Planck fractions    *
+!     per g-value and layer for band n.                                       *
+!                                                                             *
+!  Output:  optical depths (unitless)                                         *
+!           fractions needed to compute Planck functions at every layer       *
+!               and g-value                                                   *
+!                                                                             *
+!     COMMON /TAUGCOM/  TAUG(MXLAY,MG)                                        *
+!     COMMON /PLANKG/   FRACS(MXLAY,MG)                                       *
+!                                                                             *
+!  Input                                                                      *
+!                                                                             *
+!     COMMON /FEATURES/ NG(NBANDS),NSPA(NBANDS),NSPB(NBANDS)                  *
+!     COMMON /PRECISE/  ONEMINUS                                              *
+!     COMMON /PROFILE/  NLAYERS,PAVEL(MXLAY),TAVEL(MXLAY),                    *
+!    &                  PZ(0:MXLAY),TZ(0:MXLAY),TBOUND                        *
+!     COMMON /PROFDATA/ LAYTROP,LAYSWTCH,LAYLOW,                              *
+!    &                  COLH2O(MXLAY),COLCO2(MXLAY),                          *
+!    &                  COLO3(MXLAY),COLN2O(MXLAY),COLCH4(MXLAY),             *
+!    &                  COLO2(MXLAY),CO2MULT(MXLAY)                           *
+!     COMMON /INTFAC/   FAC00(MXLAY),FAC01(MXLAY),                            *
+!    &                  FAC10(MXLAY),FAC11(MXLAY)                             *
+!     COMMON /INTIND/   JP(MXLAY),JT(MXLAY),JT1(MXLAY)                        *
+!     COMMON /SELF/     SELFFAC(MXLAY), SELFFRAC(MXLAY), INDSELF(MXLAY)       *
+!                                                                             *
+!     Description:                                                            *
+!     NG(IBAND) - number of g-values in band IBAND                            *
+!     NSPA(IBAND) - for the lower atmosphere, the number of reference         *
+!                   atmospheres that are stored for band IBAND per            *
+!                   pressure level and temperature.  Each of these            *
+!                   atmospheres has different relative amounts of the         *
+!                   key species for the band (i.e. different binary           *
+!                   species parameters).                                      *
+!     NSPB(IBAND) - same for upper atmosphere                                 *
+!     ONEMINUS - since problems are caused in some cases by interpolation     *
+!                parameters equal to or greater than 1, for these cases       *
+!                these parameters are set to this value, slightly < 1.        *
+!     PAVEL - layer pressures (mb)                                            *
+!     TAVEL - layer temperatures (degrees K)                                  *
+!     PZ - level pressures (mb)                                               *
+!     TZ - level temperatures (degrees K)                                     *
+!     LAYTROP - layer at which switch is made from one combination of         *
+!               key species to another                                        *
+!     COLH2O, COLCO2, COLO3, COLN2O, COLCH4 - column amounts of water         *
+!               vapor,carbon dioxide, ozone, nitrous ozide, methane,          *
+!               respectively (molecules/cm**2)                                *
+!     CO2MULT - for bands in which carbon dioxide is implemented as a         *
+!               trace species, this is the factor used to multiply the        *
+!               band's average CO2 absorption coefficient to get the added    *
+!               contribution to the optical depth relative to 355 ppm.        *
+!     FACij(LAY) - for layer LAY, these are factors that are needed to        *
+!                  compute the interpolation factors that multiply the        *
+!                  appropriate reference k-values.  A value of 0 (1) for      *
+!                  i,j indicates that the corresponding factor multiplies     *
+!                  reference k-value for the lower (higher) of the two        *
+!                  appropriate temperatures, and altitudes, respectively.     *
+!     JP - the index of the lower (in altitude) of the two appropriate        *
+!          reference pressure levels needed for interpolation                 *
+!     JT, JT1 - the indices of the lower of the two appropriate reference     *
+!               temperatures needed for interpolation (for pressure           *
+!               levels JP and JP+1, respectively)                             *
+!     SELFFAC - scale factor needed to water vapor self-continuum, equals     *
+!               (water vapor density)/(atmospheric density at 296K and        *
+!               1013 mb)                                                      *
+!     SELFFRAC - factor needed for temperature interpolation of reference     *
+!                water vapor self-continuum data                              *
+!     INDSELF - index of the lower of the two appropriate reference           *
+!               temperatures needed for the self-continuum interpolation      *
+!                                                                             *
+!  Data input                                                                 *
+!     COMMON /Kn/ KA(NSPA(n),5,13,MG), KB(NSPB(n),5,13:59,MG), SELFREF(10,MG) *
+!        (note:  n is the band number)                                        *
+!                                                                             *
+!     Description:                                                            *
+!     KA - k-values for low reference atmospheres (no water vapor             *
+!          self-continuum) (units: cm**2/molecule)                            *
+!     KB - k-values for high reference atmospheres (all sources)              *
+!          (units: cm**2/molecule)                                            *
+!     SELFREF - k-values for water vapor self-continuum for reference         *
+!               atmospheres (used below LAYTROP)                              *
+!               (units: cm**2/molecule)                                       *
+!                                                                             *
+!     DIMENSION ABSA(65*NSPA(n),MG), ABSB(235*NSPB(n),MG)                     *
+!     EQUIVALENCE (KA,ABSA),(KB,ABSB)                                         *
+!                                                                             *
+!******************************************************************************
+
+SUBROUTINE RRTM_TAUMOL1 (KLEV,P_TAU,&
+ & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,K_JP,K_JT,K_JT1,&
+ & P_COLH2O,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  
+
+!     Written by Eli J. Mlawer, Atmospheric & Environmental Research.
+!     Revised by Michael J. Iacono, Atmospheric & Environmental Research.
+
+!     BAND 1:  10-250 cm-1 (low - H2O; high - H2O)
+ 
+! Modifications
+!        M.Hamrud      01-Oct-2003 CY28 Cleaning
+
+!     D Salmond   2000-05-15 speed-up
+!     JJMorcrette 2000-05-17 speed-up
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE PARRRTM  , ONLY : JPLAY  ,JPBAND ,JPGPT  ,NG1
+USE YOERRTWN , ONLY :      NSPA   ,NSPB
+USE YOERRTA1 , ONLY : ABSA   ,ABSB   ,FRACREFA, FRACREFB,&
+ & FORREF   ,SELFREF   
+
+!#include "yoeratm.h"
+
+!      REAL TAUAER(JPLAY)
+
+IMPLICIT NONE
+
+!  Output
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAU(JPGPT,JPLAY) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUAERL(JPLAY,JPBAND) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(JPLAY) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(JPLAY) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(JPLAY) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(JPLAY) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFAC(JPLAY) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(JPLAY) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(JPLAY) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(JPLAY) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(JPLAY) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(JPLAY) 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(JPLAY) 
+INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(JPLAY) 
+REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(JPGPT,JPLAY) 
+!- from AER
+!- from INTFAC      
+!- from INTIND
+!- from PRECISE             
+!- from PROFDATA             
+!- from SELF             
+!- from SP             
+INTEGER(KIND=JPIM) :: IND0(JPLAY),IND1(JPLAY),INDS(JPLAY)
+
+INTEGER(KIND=JPIM) :: IG, I_LAY
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+!      EQUIVALENCE (TAUAERL(1,1),TAUAER)
+
+!     Compute the optical depth by interpolating in ln(pressure) and 
+!     temperature.  Below LAYTROP, the water vapor self-continuum 
+!     is interpolated (in temperature) separately.  
+
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL1',0,ZHOOK_HANDLE)
+!--ajout OB 
+IF (K_LAYTROP.GT.100) THEN 
+PRINT *,'ATTENTION KLAY_TROP > 100 PROBLEME ARRAY DANS RRTM ON ARRETE'
+STOP
+!--fin ajout OB
+ENDIF
+DO I_LAY = 1, K_LAYTROP
+  IND0(I_LAY) = ((K_JP(I_LAY)-1)*5+(K_JT(I_LAY)-1))*NSPA(1) + 1
+  IND1(I_LAY) = (K_JP(I_LAY)*5+(K_JT1(I_LAY)-1))*NSPA(1) + 1
+  INDS(I_LAY) = K_INDSELF(I_LAY)
+ENDDO
+
+DO IG = 1, NG1
+  DO I_LAY = 1, K_LAYTROP
+!-- DS_000515  
+    P_TAU (IG,I_LAY) = P_COLH2O(I_LAY) *&
+     & (P_FAC00(I_LAY) * ABSA(IND0(I_LAY)  ,IG) +&
+     & P_FAC10(I_LAY) * ABSA(IND0(I_LAY)+1,IG) +&
+     & P_FAC01(I_LAY) * ABSA(IND1(I_LAY)  ,IG) +&
+     & P_FAC11(I_LAY) * ABSA(IND1(I_LAY)+1,IG) +&
+     & P_SELFFAC(I_LAY) * (SELFREF(INDS(I_LAY),IG) + &
+     & P_SELFFRAC(I_LAY) *&
+     & (SELFREF(INDS(I_LAY)+1,IG) - SELFREF(INDS(I_LAY),IG)))&
+     & + P_FORFAC(I_LAY) * FORREF(IG) ) &
+     & + P_TAUAERL(I_LAY,1)  
+    PFRAC(IG,I_LAY) = FRACREFA(IG)
+  ENDDO
+ENDDO
+
+DO I_LAY = K_LAYTROP+1, KLEV
+  IND0(I_LAY) = ((K_JP(I_LAY)-13)*5+(K_JT(I_LAY)-1))*NSPB(1) + 1
+  IND1(I_LAY) = ((K_JP(I_LAY)-12)*5+(K_JT1(I_LAY)-1))*NSPB(1) + 1
+ENDDO
+
+!-- JJM000517
+DO IG = 1, NG1
+  DO I_LAY = K_LAYTROP+1, KLEV
+!-- JJM000517
+    P_TAU (IG,I_LAY) = P_COLH2O(I_LAY) *&
+     & (P_FAC00(I_LAY) * ABSB(IND0(I_LAY)  ,IG) +&
+     & P_FAC10(I_LAY) * ABSB(IND0(I_LAY)+1,IG) +&
+     & P_FAC01(I_LAY) * ABSB(IND1(I_LAY)  ,IG) +&
+     & P_FAC11(I_LAY) * ABSB(IND1(I_LAY)+1,IG)&
+     & + P_FORFAC(I_LAY) * FORREF(IG) ) &
+     & + P_TAUAERL(I_LAY,1)  
+    PFRAC(IG,I_LAY) = FRACREFB(IG)
+  ENDDO
+ENDDO
+
+IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL1',1,ZHOOK_HANDLE)
+END SUBROUTINE RRTM_TAUMOL1
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/rrtm_taumol2.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/rrtm_taumol2.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/rrtm_taumol2.F90	(revision 5133)
@@ -23,5 +23,5 @@
 USE YOERRTBG2, ONLY : CORR1  ,CORR2
 
-USE print_control_mod, ONLY: mydebug=>debug , lunout, prt_level, &
+USE lmdz_print_control, ONLY: mydebug=>debug , lunout, prt_level, &
  & alert_first_call, call_alert, prt_alerte
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/set99.F
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/set99.F	(revision 5133)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/set99.F	(revision 5133)
@@ -0,0 +1,59 @@
+      SUBROUTINE SET99(TRIGS,IFAX,N)
+      REAL             TRIGS(N)
+      INTEGER IFAX(*),JFAX(10),NLFAX(7)
+C
+C     SUBROUTINE 'SET99' - COMPUTES FACTORS OF N & TRIGONOMETRIC
+C     FUNCTIONS REQUIRED BY FFT99 & FFT991
+C
+      SAVE NLFAX
+C
+      DATA NLFAX/6,8,5,4,3,2,1/
+C
+      IXXX=1
+C
+      DEL=4.0E0*ASIN(1.0E0)/FLOAT(N)
+      NIL=0
+      NHL=(N/2)-1
+      DO 10 K=NIL,NHL
+      ANGLE=FLOAT(K)*DEL
+      TRIGS(2*K+1)=COS(ANGLE)
+      TRIGS(2*K+2)=SIN(ANGLE)
+   10 CONTINUE
+C
+C     FIND FACTORS OF N (8,6,5,4,3,2; ONLY ONE 8 ALLOWED)
+C     LOOK FOR SIXES FIRST, STORE FACTORS IN DESCENDING ORDER
+      NU=N
+      IFAC=6
+      K=0
+      IL=1
+   20 CONTINUE
+      IF (MOD(NU,IFAC).NE.0) GO TO 30
+      K=K+1
+      JFAX(K)=IFAC
+      IF (IFAC.NE.8) GO TO 25
+      IF (K.EQ.1) GO TO 25
+      JFAX(1)=8
+      JFAX(K)=6
+   25 CONTINUE
+      NU=NU/IFAC
+      IF (NU.EQ.1) GO TO 50
+      IF (IFAC.NE.8) GO TO 20
+   30 CONTINUE
+      IL=IL+1
+      IFAC=NLFAX(IL)
+      IF (IFAC.GT.1) GO TO 20
+C
+      WRITE(6,40) N
+   40 FORMAT(4H1N =,I4,27H - CONTAINS ILLEGAL FACTORS)
+      RETURN
+C
+C     NOW REVERSE ORDER OF FACTORS
+   50 CONTINUE
+      NFAX=K
+      IFAX(1)=NFAX
+      DO 60 I=1,NFAX
+      IFAX(NFAX+2-I)=JFAX(I)
+   60 CONTINUE
+      IFAX(10)=N
+      RETURN
+      END
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/suecrad.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/suecrad.F90	(revision 5133)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/suecrad.F90	(revision 5133)
@@ -0,0 +1,1541 @@
+!
+! $Id: suecrad.F90 4251 2022-09-20 00:22:43Z fhourdin $
+!
+SUBROUTINE SUECRAD (KULOUT, KLEV, PETAH )
+
+!**** *SUECRAD*   - INITIALIZE COMMONS YOERxx CONTROLLING RADIATION
+
+!     PURPOSE.
+!     --------
+!           INITIALIZE YOERAD, THE COMMON THAT CONTROLS THE
+!           RADIATION OF THE MODEL, AND YOERDU THAT INCLUDES
+!           ADJUSTABLE PARAMETERS FOR RADIATION COMPUTATIONS
+
+!**   INTERFACE.
+!     ----------
+!        CALL *SUECRAD* FROM *SUPHEC*
+!              -------        ------
+
+!        EXPLICIT ARGUMENTS :
+!        --------------------
+!        NONE
+
+!        IMPLICIT ARGUMENTS :
+!        --------------------
+!        COMMONS YOERAD, YOERDU
+
+!     METHOD.
+!     -------
+!        SEE DOCUMENTATION
+
+!     EXTERNALS.
+!     ----------
+!        SUAER, SUAERH, SUAERV, SULW, SUSW, SUOCST, SUSAT
+!        SUAERL, SUAERSN, SUSRTAER, SRTM_INIT, SUSRTCOP
+
+!     REFERENCE.
+!     ----------
+!        ECMWF Research Department documentation of the IFS
+
+!     AUTHOR.
+!     -------
+!        JEAN-JACQUES MORCRETTE  *ECMWF*
+
+!     MODIFICATIONS.
+!     --------------
+!        ORIGINAL : 88-12-15
+!        P.COURTIER AND M.HAMRUD NAME SURAD ALREADY USED
+!        Modified 93-11-15 by Ph. Dandin : FMR scheme with MF
+!        Modified 95-12 by PhD : Cloud overlapping hypothesis for FMR
+!        980317 JJMorcrette clean-up (NRAD, NFLUX)
+!        000118 JJMorcrette variable concentr. uniformly mixed gases
+!        990525 JJMorcrette GISS volcanic and new tropospheric aerosols
+!        990831 JJMorcrette RRTM
+!        R. El Khatib 01-02-02 proper initialization of NFRRC moved in SUCFU
+!        010129 JJMorcrette clean-up LERAD1H, NLNGR1H
+!        011105 GMozdzynski support new radiation grid
+!        011005 JJMorcrette CCN --> Re Water clouds
+!        R. El Khatib 01-02-02 LRRTM=lecmwf by default
+!        020909 GMozdzynski support NRADRES to specify radiation grid
+!        021001 GMozdzynski support on-demand radiation communications
+!        030422 GMozdzynski automatic min-halo
+!        030501 JJMorcrette new radiation grid on, new aerosols on (default)
+!        030513 JJMorcrette progn. O3 / radiation interactions off (default)
+!        M.Hamrud      01-Oct-2003 CY28 Cleaning
+!        050315 JJMorcrette prog.aerosols v1
+!        041214 JJMorcrette SRTM
+!        050111 JJMorcrette new cloud optical properties
+!        050415 GMozdzynski Reduced halo support for radiation interpolation
+!        051004 JJMorcrette UV surface radiation processor
+!        051220 JJMorcrette SRTM112g+LWSCAT+UVprocessor+(bgfx:swclr, radaca)
+!        060510 JJMorcrette MODIS albedo (UVis, NIR)x(parallel+diffuse)
+!        060510 JJMorcrette MODIS albedo (UVis, NIR)x(parallel+diffuse)
+!        JJMorcrette 20060721 PP of clear-sky PAR and TOA incident solar radiation
+!        060625 JJMorcrette MODIS albedo (UVis, NIR)x(parallel+diffuse)
+!        060726 JJMorcrette McICA default operational configuration
+!     ------------------------------------------------------------------
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
+
+USE PARDIM   , ONLY : JPMXGL
+USE PARRRTM  , ONLY : JPLAY
+USE PARSRTM  , ONLY : JPGPT
+USE YOMCT0   , ONLY : LOUTPUT  ,NPRINTLEV,LALLOPR,&
+ & NPROC    ,N_REGIONS_NS  ,N_REGIONS_EW
+USE YOMDIM   , ONLY : NDLON    ,NSMAX    ,NDGENL    ,&
+ & NDGSAL   ,NDGLG    ,NDGSAG   ,NDGENG   ,NDSUR1    ,&
+ & NDLSUR   ,NDGSUR   ,NGPBLKS  ,NFLEVG   ,NPROMA  
+USE YOMCT0B  , ONLY : LECMWF
+USE YOMDYN   , ONLY : TSTEP
+! Ce qui concerne NULRAD commente par MPL le 15.04.09
+!USE YOMLUN   , ONLY : NULNAM   ,NULRAD   ,NULOUT
+USE YOMLUN   , ONLY : NULRAD   ,NULOUT
+USE YOMCST   , ONLY : RDAY     ,RG       ,RCPD     ,RPI     ,RI0
+USE YOMPHY   , ONLY : LMPHYS, LRAYFM   ,LRAYFM15
+USE YOEPHY   , ONLY : LEPHYS   ,LERADI, LE4ALB
+USE YOERDI   , ONLY : RCCO2, RCCH4, RCN2O, RCCFC11, RCCFC12, RSOLINC
+USE YOERAD   , ONLY : NAER     , NOZOCL   ,&
+ & NRADFR   ,NRADPFR  ,NRADPLA  ,NRINT    ,&
+ & NRADNFR  ,NRADSFR  ,NOVLP    ,NRPROMA  ,&
+!& NLW      ,NSW      ,NTSW     ,NCSRADF  ,&
+! NSW mis dans .def MPL 20140211
+ & NLW      ,NTSW     ,NCSRADF  ,&
+ & NMODE    ,NLNGR1H  ,NSWNL    ,NSWTL    ,NUV     ,&
+ & LERAD1H  ,LERADHS  ,LEPO3RA  ,LRADLB   ,LONEWSW ,&
+ & LCCNL    ,LCCNO    ,&
+ & LECSRAD  ,LHVOLCA  ,LNEWAER  ,LRRTM    ,LSRTM   ,LDIFFC  ,&
+ & NRADINT  ,NRADRES  ,CRTABLEDIR,CRTABLEFIL       ,&
+ & NICEOPT  ,NLIQOPT  ,NRADIP   ,NRADLP   ,NINHOM  ,NLAYINH ,&
+ & LRAYL    ,LOPTRPROMA,&
+ & RCCNLND  ,RCCNSEA  ,RLWINHF  ,RSWINHF  ,RRe2De  ,&
+ & RPERTOZ  ,NPERTOZ  ,NMCICA   ,&
+ & LNOTROAER,NPERTAER ,LECO2VAR ,LHGHG    ,NHINCSOL,NSCEN ,&
+ & LEDBUG
+USE YOERDU   , ONLY : NUAER    ,NTRAER   ,RCDAY    ,R10E     ,&
+ & REPLOG   ,REPSC    ,REPSCO   ,REPSCQ   ,REPSCT   ,&
+ & REPSCW   ,DIFF  
+USE YOEAERD  , ONLY : CVDAES   ,CVDAEL   ,CVDAEU   ,CVDAED   ,&
+ & RCAEOPS  ,RCAEOPL  ,RCAEOPU  ,RCAEOPD  ,RCTRBGA  ,&
+ & RCVOBGA  ,RCSTBGA  ,RCTRPT   ,RCAEADM  ,RCAEROS  ,            &
+ & RCAEADK  
+USE YOE_UVRAD, ONLY : JUVLAM, LUVPROC, LUVTDEP, LUVDBG, NRADUV, NUVTIM, RUVLAM, RMUZUV
+
+USE YOMMP    , ONLY : MYPROC   ,NPRCIDS  ,LSPLIT   ,NAPSETS  ,&
+ & NPTRFLOFF,NFRSTLOFF,MYFRSTACTLAT,MYLSTACTLAT,&
+ & NSTA,NONL,NPTRFRSTLAT,NFRSTLAT,NLSTLAT ,&
+ & MY_REGION_NS  ,MY_REGION_EW   ,NGLOBALINDEX ,&
+ & NRISTA  ,NRIONL   ,NRIOFF    ,NRIEXT   ,NRICORE ,&
+ & NRISENDPOS ,NRIRECVPOS ,NRISENDPTR ,NRIRECVPTR ,&
+ & NARIB1  ,NRIPROCS ,NRIMPBUFSZ,NRISPT   ,NRIRPT ,&
+ & NRICOMM ,&
+ & NROSTA  ,NROONL   ,NROOFF    ,NROEXT   ,NROCORE ,&
+ & NROSENDPOS ,NRORECVPOS ,NROSENDPTR ,NRORECVPTR ,&
+ & NAROB1  ,NROPROCS ,NROMPBUFSZ,NROSPT   ,NRORPT ,&
+ & NROCOMM
+USE YOMGC    , ONLY : GELAT    ,GELAM
+USE YOMLEG   , ONLY : RMU      ,RSQM2
+USE YOMSC2   , ONLY : &
+ & NRIWIDEN  ,NRIWIDES  ,NRIWIDEW  ,NRIWIDEE,&
+ & NROWIDEN  ,NROWIDES  ,NROWIDEW  ,NROWIDEE
+USE YOMGEM   , ONLY : NGPTOT   ,NGPTOTG   ,NGPTOTMX ,NLOENG
+USE YOMTAG   , ONLY : MTAGRAD
+USE YOMPRAD  , ONLY : LODBGRADI,LODBGRADL ,RADGRID  ,&
+ & LRADONDEM  
+USE YOMRADF  , ONLY : EMTD     ,TRSW     ,EMTC      ,TRSC    ,&
+ & SRSWD    ,SRLWD    ,SRSWDCS  ,SRLWDCS   ,SRSWDV  ,&
+ & SRSWDUV  ,EDRO     ,SRSWPAR  ,SRSWUVB   ,SRSWPARC,  SRSWTINC,&
+ & EMTU, RMOON
+! Commente par MPL 26.11.08 
+!USE YOPHNC   , ONLY :  LERADN2
+! MPLefebvre 6-11-08 commente tout ce qui concerne MPL_MODULE
+!USE MPL_MODULE  , ONLY :  MPL_BROADCAST, MPL_SEND, MPL_RECV
+USE YOM_YGFL , ONLY : YO3
+!!!!! A REVOIR (MPL) NDLNPR devrait etre initialise dans sudyn.F90
+USE YOMDYN   , ONLY : NDLNPR
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
+INTEGER(KIND=JPIM),INTENT(IN)    :: KULOUT 
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PETAH(KLEV+1) 
+!     LOCAL ARRAYS FOR THE PURPOSE OF READING NAMRGRI (RADIATION GRID)
+INTEGER(KIND=JPIM) :: NRGRI(JPMXGL)
+
+INTEGER(KIND=JPIM) :: IDGL,INBLW,IRADFR,IST1HR,ISTNHR,IDIR,IFIL
+INTEGER(KIND=JPIM) :: IRIRPTSUR,IRISPTSUR,IRIMAPLEN
+INTEGER(KIND=JPIM) :: JLON,JGLAT,JGL,JGLSUR,IDLSUR,IOFF,ILAT,ISTLON,IENDLON
+INTEGER(KIND=JPIM) :: IRORPTSUR,IROSPTSUR,IROMAPLEN
+INTEGER(KIND=JPIM) :: ILBRLATI,IUBRLATI,IGLGLO,IDUM,IU
+INTEGER(KIND=JPIM) :: J,JROC,IGPTOT
+INTEGER(KIND=JPIM) :: IROWIDEMAXN,IROWIDEMAXS,IROWIDEMAXW,IROWIDEMAXE
+INTEGER(KIND=JPIM) :: IRIWIDEMAXN,IRIWIDEMAXS,IRIWIDEMAXW,IRIWIDEMAXE
+INTEGER(KIND=JPIM) :: IARIB1MAX,IAROB1MAX
+INTEGER(KIND=JPIM) :: IWIDE(10)
+INTEGER(KIND=JPIM) :: ILATS_DIFF_F,ILATS_DIFF_C
+INTEGER(KIND=JPIM), PARAMETER :: JP_MIN_HALO=5
+INTEGER(KIND=JPIM) :: ISW,JUV,IDAYUV
+
+LOGICAL :: LLINEAR_GRID
+LOGICAL :: LLDEBUG,LLP
+
+REAL(KIND=JPRB) :: ZSTPHR, ZTSTEP, ZGEMU, ZLON, ZD1, ZD2, ZD3, ZD4, ZD5, ZD6
+REAL(KIND=JPRB) :: ZMINRADLAT,ZMAXRADLAT,ZMINRADLON,ZMAXRADLON
+REAL(KIND=JPRB) :: ZMINMDLLAT,ZMAXMDLLAT,ZMINMDLLON,ZMAXMDLLON
+REAL(KIND=JPRB) :: ZLAT
+!REAL(KIND=JPRB) :: RLATVOL, RLONVOL
+
+CHARACTER (LEN = 300) ::  CLFN
+INTEGER(KIND=JPIM), PARAMETER :: JPIOMASTER=1
+
+INTEGER(KIND=JPIM), ALLOCATABLE :: IRISENDPOS(:)
+INTEGER(KIND=JPIM), ALLOCATABLE :: IRIRECVPOS(:)
+INTEGER(KIND=JPIM), ALLOCATABLE :: IRISENDPTR(:)
+INTEGER(KIND=JPIM), ALLOCATABLE :: IRIRECVPTR(:)
+INTEGER(KIND=JPIM), ALLOCATABLE :: IRICOMM(:)
+INTEGER(KIND=JPIM), ALLOCATABLE :: IRIMAP(:,:)
+INTEGER(KIND=JPIM), ALLOCATABLE :: IROSENDPOS(:)
+INTEGER(KIND=JPIM), ALLOCATABLE :: IRORECVPOS(:)
+INTEGER(KIND=JPIM), ALLOCATABLE :: IROSENDPTR(:)
+INTEGER(KIND=JPIM), ALLOCATABLE :: IRORECVPTR(:)
+INTEGER(KIND=JPIM), ALLOCATABLE :: IROCOMM(:)
+INTEGER(KIND=JPIM), ALLOCATABLE :: IROMAP(:,:)
+INTEGER(KIND=JPIM), ALLOCATABLE :: IGLOBALINDEX(:)
+
+REAL(KIND=JPRB),ALLOCATABLE :: ZLATX(:)
+REAL(KIND=JPRB),ALLOCATABLE :: ZLONX(:)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+INTERFACE
+#include "setup_trans.h"
+#include "trans_inq.h"
+END INTERFACE
+
+#include "abor1.intfb.h"
+#include "posnam.intfb.h"
+#include "rrtm_init_140gp.intfb.h"
+
+#include "rdcset.intfb.h"
+#include "suaerh.intfb.h"
+#include "suaerl.intfb.h"
+#include "suaersn.intfb.h"
+#include "suaerv.intfb.h"
+#include "suclopn.intfb.h"
+#include "suecradi.intfb.h"
+#include "suecradl.intfb.h"
+#include "sulwn.intfb.h"
+#include "sulwneur.intfb.h"
+#include "suovlp.intfb.h"
+#include "surdi.intfb.h"
+#include "surrtab.intfb.h"
+#include "surrtftr.intfb.h"
+#include "surrtpk.intfb.h"
+#include "surrtrf.intfb.h"
+#include "susat.intfb.h"
+#include "suswn.intfb.h"
+#include "susrtaer.intfb.h"
+#include "srtm_init.intfb.h"
+#include "susrtcop.intfb.h"
+#include "su_aerw.intfb.h"
+#include "su_uvrad.intfb.h"
+#include "su_mcica.intfb.h"
+
+!      ----------------------------------------------------------------
+
+#include "clesphys.h"
+#include "naerad.h"
+#include "namrgri.h"
+!MPL/IM 20160915 on prend GES de phylmd
+
+!*         1.       INITIALIZE NEUROFLUX LONGWAVE RADIATION
+!                   ---------------------------------------
+
+IF (LHOOK) CALL DR_HOOK('SUECRAD',0,ZHOOK_HANDLE)
+!CALL GSTATS(1818,0)     MPL 2.12.08
+!IF (LERADN2) THEN
+!  CALL SULWNEUR(KLEV)
+!ENDIF
+
+!*         2.       SET DEFAULT VALUES.
+!                   -------------------
+
+!*         2.1      PRESET INDICES IN *YOERAD*
+!                   --------------------------
+
+LERAD1H=.FALSE.
+NLNGR1H=6
+
+LERADHS=.TRUE.
+LONEWSW=.TRUE.
+LECSRAD=.FALSE.
+
+!LE4ALB=.FALSE.
+!This is read from SU0PHY in NAEPHY and put in YOEPHY
+
+!- default setting of cloud optical properties
+!  liquid water cloud 0: Fouquart    (SW), Smith-Shi   (LW)
+!                     1: Slingo      (SW), Savijarvi   (LW)
+!                     2: Slingo      (SW), Lindner-Li  (LW)
+!  ice water cloud    0: Ebert-Curry (SW), Smith-Shi   (LW)
+!                     1: Ebert-Curry (SW), Ebert-Curry (LW)
+!                     2: Fu-Liou'93  (SW), Fu-Liou'93  (LW)
+!                     3: Fu'96       (SW), Fu et al'98 (LW)
+NLIQOPT=2           ! before 3?R1 default=0    2
+NICEOPT=3           ! before 3?R1 default=1    3
+
+!- default setting of cloud effective radius/diameter
+!  liquid water cloud 0: f(P) 10 to 45
+!                     1: 13: ocean; 10: land
+!                     2: Martin et al. CCN 50 over ocean, 900 over land
+!  ice water cloud    0: 40 microns
+!                     1: f(T) 40 to 130 microns
+!                     2: f(T) 30 to 60
+!                     3: f(T,IWC) Sun'01: 22.5 to 175 microns
+!  conversion factor between effective radius and particle size for ice
+NRADIP=3            ! before 3?R1 default=2 	3
+NRADLP=2            ! before 3?R1 default=2	2
+print *,'SUECRAD: NRADLP, NRADIP=',NRADLP,NRADIP
+RRe2De=0.64952_JPRB ! before 3?R1 default=0.5_JPRB
+
+!- RRTM as LW scheme
+LRRTM  = .FALSE.
+LECMWF = .FALSE.
+IF (iflag_rrtm.EQ.1) THEN
+        LRRTM  = .TRUE.
+        LECMWF = .TRUE.
+!       LRRTM  = .FALSE.  ! Utiliser pour faire tourner le "vieux" rayonnement
+!       LECMWF = .FALSE. 
+ENDIF
+
+!LRRTM  = .FALSE.
+
+!- SRTM as SW scheme
+!!!!! A REVOIR (MPL) verifier signification de LSRTM
+LSRTM = .FALSE.     ! before 3?R1 default was .FALSE.    true
+
+! -- McICA treatment of cloud-radiation interactions 
+! - 1 is maximum-random, 2 is generalized cloud overlap (before 31R1 default=0 no McICA)
+NMcICA = 2          !  2 for generalized overlap
+
+!- Inhomogeneity factors in LW and SW (0=F, 1=0.7 in both, 2=Barker's, 3=Cairns)
+NINHOM = 0          ! before 3?R1 default=1
+NLAYINH= 0
+RLWINHF = 1.0_JPRB  ! before 3?R1 default=0.7
+RSWINHF = 1.0_JPRB  ! before 3?R1 default=0.7  
+!- Diffusivity correction a la Savijarvi
+LDIFFC = .FALSE.    ! before 31R1 default=.FALSE. 
+
+!- history of volcanic aerosols
+LHVOLCA=.FALSE.
+!- monthly climatol. of tropospheric aerosols from Tegen et al. (1997)
+LNEWAER=.TRUE.
+!!! cpl LNOTROAER=.FALSE.
+LNOTROAER=.TRUE.
+NPERTAER=0
+
+!- New Rayleigh formulation
+LRAYL=.TRUE.
+
+!- Number concentration of aerosols if specified
+LCCNL=.TRUE.        ! before 3?R1 default=.FALSE.     true
+LCCNO=.TRUE.        ! before 3?R1 default=.FALSE.     true
+RCCNLND=900._JPRB   ! before 3?R1 default=900. now irrelevant
+RCCNSEA=50._JPRB    ! before 3?R1 default=50.  now irrelevant
+
+!- interaction radiation / prognostic O3 off by default
+LEPO3RA=.FALSE.
+print *,'SUECRAD-0'
+IF (.NOT.YO3%LGP) THEN
+  LEPO3RA=.FALSE.
+ENDIF
+RPERTOZ=0._JPRB
+NPERTOZ=0
+
+!NAER: CONFIGURATION INDEX FOR AEROSOLS
+!!!!! A REVOIR (MPL) a mettre dans un fichier .def
+NAER   =1
+NMODE  =0
+NOZOCL =1
+NRADFR =-3
+IF (NSMAX >= 511) NRADFR =-1
+NRADPFR=0
+NRADPLA=15
+
+! -- UV diagnostic of surface fluxes over the 280-400 nm interval 
+!    with up-to 24 values (5 nm wide spectral intervals)
+LUVPROC=.FALSE.
+LUVTDEP=.TRUE.
+LUVDBG =.FALSE.
+NRADUV =-3
+NUVTIM = 0
+NUV    = 24
+RMUZUV = 1.E-01_JPRB
+DO JUV=1,NUV
+  RUVLAM(JUV)=280._JPRB+(JUV-1)*5._JPRB
+ENDDO
+
+!- radiation interpolation (George M's grid on by default)
+LLDEBUG=.TRUE.
+LEDBUG=.FALSE.
+NRADINT=3
+NRADRES=0
+
+NRINT  =4
+
+LRADLB=.TRUE.
+CRTABLEDIR='./'
+CRTABLEFIL='not set'
+LRADONDEM=.TRUE.
+!GM Temporary as per trans/external/setup_trans.F90
+LLINEAR_GRID=NSMAX > (NDLON+3)/3
+IF( LLDEBUG )THEN
+  WRITE(NULOUT,'("SUECRAD: NSMAX=",I6)')NSMAX
+  WRITE(NULOUT,'("SUECRAD: NDLON=",I6)')NDLON
+  WRITE(NULOUT,'("SUECRAD: LLINEAR_GRID=",L5)')LLINEAR_GRID
+ENDIF
+
+NUAER  = 24
+NTRAER = 15
+! 1: max-random, 2: max, 3: random (5,6,7,8 pour meso-NH)
+! le CASE qui suit car les conventions sont differentes dans ARP et LMDZ (MPL 20100415)
+SELECT CASE (overlap)
+  CASE (:1)
+   NOVLP = 2    
+  CASE (2)
+   NOVLP = 3    
+  CASE (3:)
+   NOVLP = 1    
+  END SELECT
+print *,'SUECRAD: NOVLP=',NOVLP
+NLW    = 16
+NTSW   = 14
+!NSW    = 6    !!!!! Maintenant dans config.def (MPL 20140213)
+NSWNL  = 6
+NSWTL  = 2
+NCSRADF= 1
+IF(NSMAX >= 106) THEN
+  NRPROMA = 80
+ELSEIF(NSMAX == 63) THEN
+  NRPROMA=48
+ELSE
+  NRPROMA=64
+ENDIF
+
+!*         2.3      SET SECURITY PARAMETERS
+!                   -----------------------
+
+REPSC  = 1.E-04_JPRB
+REPSCO = 1.E-12_JPRB
+REPSCQ = 1.E-12_JPRB
+REPSCT = 1.E-12_JPRB
+REPSCW = 1.E-12_JPRB
+REPLOG = 1.E-12_JPRB
+
+
+!*          2.4     BACKGROUND GAS CONCENTRATIONS (IPCC/SACC, 1990)
+!                   -----------------------------------------------
+
+LECO2VAR=.FALSE.
+LHGHG   =.FALSE.
+NHINCSOL= 0
+NSCEN   = 1
+RSOLINC = RI0
+
+! Valeurs d origine MPL 18052010
+!RCCO2   = 353.E-06_JPRB
+!RCCH4   = 1.72E-06_JPRB
+!RCN2O   = 310.E-09_JPRB
+!RCCFC11 = 280.E-12_JPRB
+!RCCFC12 = 484.E-12_JPRB
+
+! Valeurs LMDZ (physiq.def) MPL 18052010
+!RCCO2   = 348.E-06_JPRB
+!RCCH4   = 1.65E-06_JPRB
+!RCN2O   = 306.E-09_JPRB
+!RCCFC11 = 280.E-12_JPRB
+!RCCFC12 = 484.E-12_JPRB
+
+!MPL/IM 20160915 on prend GES de phylmd
+RCCO2   = CO2_ppm * 1.0e-06
+RCCH4   = CH4_ppb * 1.0e-09
+RCN2O   = N2O_ppb * 1.0e-09
+RCCFC11 = CFC11_ppt * 1.0e-12
+RCCFC12 = CFC12_ppt * 1.0e-12
+!print *,'LMDZSUECRAD-1 RCCO2=',RCCO2
+!print *,'LMDZSUECRAD-1 RCCH4=',RCCH4
+!print *,'LMDZSUECRAD-1 RCN2O=',RCN2O
+!print *,'LMDZSUECRAD-1 RCCFC11=',RCCFC11
+!print *,'LMDZSUECRAD-1 RCCFC12=',RCCFC12
+!     ------------------------------------------------------------------
+
+!*         3.       READ VALUES OF RADIATION CONFIGURATION
+!                   --------------------------------------
+
+!CALL POSNAM(NULNAM,'NAERAD')
+!READ (NULNAM,NAERAD)
+print *,'SUECRAD-2'
+
+!CALL POSNAM(NULNAM,'NAEAER')
+!READ (NULNAM,NAEAER)
+
+!IF (NTYPAER(9) /= 0) THEN
+!  RGEMUV=(RLATVOL+90._JPRB)*RPI/180._JPRB
+!  RGELAV=RLONVOL*RPI/180._JPRB
+!  RCLONV=COS(RGELAV)
+!  RSLONV=SIN(RGELAV)
+!  DO J=1,NGPTOT-1
+!    IF (RGELAV > GELAM(J) .AND. RGELAV <= GELAM(J+1) .AND. &
+!      & RGEMUV < RMU(JL) .AND. RGEMUV >= RMU(JL+1) ) THEN
+!      RDGMUV=ABS( RMU(J+1) - RMU(J))
+!      RDGLAV=ABS( GELAM(J+1)-GELAM(J) )
+!      RDSLONV=ABS( SIN(GELAM(JL+1))-SIN(GELAM(JL)) )
+!      RDCLONV=ABS( COS(GELAM(JL+1))-COS(GELAM(JL)) )
+!    END IF
+!  END DO
+!END IF  
+
+!- reset some parameters if SW6 is used (revert to pre-CY3?R1 operational configuration)
+IF (.NOT.LSRTM) THEN
+  NMcICA = 0
+  LCCNL  = .FALSE. 
+  LCCNO  = .FALSE.
+  LDIFFC = .FALSE.
+  NICEOPT= 1
+  NLIQOPT= 0
+  NRADIP = 4
+  NRADLP = 3
+  RRe2De = 0.5_JPRB
+  NINHOM = 1
+  RLWINHF= 0.7_JPRB
+  RSWINHF= 0.7_JPRB
+ENDIF
+print *,'SUECRAD-3'
+
+!- for McICA computations, make sure these parameters are as follows ...
+IF (NMCICA /= 0) THEN
+  NINHOM = 0
+  RLWINHF= 1.0_JPRB
+  RSWINHF= 1.0_JPRB
+!-- read the XCW values for Raisanen-Cole-Barker cloud generator
+  CALL SU_McICA
+ENDIF
+print *,'SUECRAD-4'
+
+
+
+IF( LLDEBUG )THEN
+  WRITE(NULOUT,'("SUECRAD: NRADINT=",I2)')NRADINT
+  WRITE(NULOUT,'("SUECRAD: NRADRES=",I4)')NRADRES
+ENDIF
+
+!     DETERMINE WHETHER NRPROMA IS NEGATIVE AND SET LOPTRPROMA
+
+LOPTRPROMA=NRPROMA > 0
+NRPROMA=ABS(NRPROMA)
+
+IF( NRADINT > 0 .AND. NRADRES == NSMAX )THEN
+  WRITE(NULOUT,'("SUECRAD: NRADINT > 0 .AND. NRADRES = NSMAX, NRADINT RESET TO 0")')
+  NRADINT=0
+ENDIF
+
+IF( NRADINT > 0 .AND. LRAYFM .AND. NAER /= 0 .AND. .NOT.LHVOLCA )THEN
+!   This combination is not supported as aerosol data would be
+!   required to be interpolated (see radintg)
+  WRITE(NULOUT,'("SUECRAD: NRADINT>0, LRAYFM=T NAER /= 0 .AND. LHVOLCA=F,",&
+   & " NRADRES RESET TO NSMAX (NO INTERPOLATION)")')  
+  NRADRES=NSMAX
+ENDIF
+!CALL GSTATS(1818,1)      MPL 2.12.08
+
+100 CONTINUE
+
+IF( LERADI )THEN   ! START OF LERADI BLOCK
+
+  IF( NRADINT == -1 )THEN
+
+  !     INITIALISE DATA STRUCTURES REQUIRED FOR RADIATION INTERPOLATION
+
+    LODBGRADI=.FALSE.
+    CALL SUECRADI
+
+  !     INITIALISE DATA STRUCTURES REQUIRED FOR RADIATION COURSE GRID
+  !     LOAD BALANCING
+
+    LODBGRADL=.FALSE.
+!   CALL SUECRADL    ! MPL 1.12.08
+    CALL ABOR1('JUSTE APRES CALL SUECRADL COMMENTE')
+
+  ELSEIF( NRADINT == 0 )THEN
+
+    IF( NRADRES /= NSMAX )THEN
+      WRITE(NULOUT,'("SUECRAD: NRADINT=0 REQUESTED, NRADRES RESET TO NSMAX")')
+      NRADRES=NSMAX
+    ENDIF
+    RADGRID%NGPTOT=NGPTOT
+
+    NARIB1=0
+    NAROB1=0
+
+  ELSEIF( NRADINT >=1 .AND. NRADINT <= 3 )THEN
+
+    NARIB1=0
+    NAROB1=0
+
+! set the default radiation grid resolution for the current model resolution
+! if not already specified
+    IF( NRADRES == 0 )THEN
+      IF( LLINEAR_GRID )THEN                ! RATIO OF GRID-POINTS (MODEL/RAD)
+        IF( NSMAX == 63 )THEN               
+          NRADRES=21                        ! 3.62
+          LLINEAR_GRID=.FALSE.
+        ENDIF
+        IF( NSMAX ==   95 ) NRADRES=   95   ! 1.00
+        IF( NSMAX ==  159 ) NRADRES=   63   ! 5.84
+        IF( NSMAX ==  255 ) NRADRES=   95   ! 6.69
+        IF( NSMAX ==  319 ) NRADRES=  159   ! 3.87
+        IF( NSMAX ==  399 ) NRADRES=  159   ! 5.99
+        IF( NSMAX ==  511 ) NRADRES=  255   ! 3.92
+        IF( NSMAX ==  639 ) NRADRES=  319   ! 3.92
+        IF( NSMAX ==  799 ) NRADRES=  399   ! 3.94
+        IF( NSMAX == 1023 ) NRADRES=  511   ! 3.94
+        IF( NSMAX == 1279 ) NRADRES=  639       ! 
+        IF( NSMAX == 2047 ) NRADRES= 1023       ! 
+      ELSE ! NOT LINEAR GRID                
+        IF( NSMAX ==   21 ) NRADRES=   21   ! 1.00
+        IF( NSMAX ==   42 ) NRADRES=   21   ! 3.62
+        IF( NSMAX ==   63 ) NRADRES=   42   ! 2.17
+        IF( NSMAX ==  106 ) NRADRES=   63   ! 2.69
+        IF( NSMAX ==  170 ) NRADRES=   63   ! 6.69
+        IF( NSMAX ==  213 ) NRADRES=  106   ! 3.87
+        IF( NSMAX ==  266 ) NRADRES=  106   ! 5.99
+        IF( NSMAX ==  341 ) NRADRES=  170   ! 3.92
+        IF( NSMAX ==  426 ) NRADRES=  213   ! 3.92
+        IF( NSMAX ==  533 ) NRADRES=  266   ! 3.94
+        IF( NSMAX ==  682 ) NRADRES=  341   ! 3.94
+      ENDIF
+    ENDIF
+print *,'SUECRAD-5'
+
+! test if radiation grid resolution has been set
+    IF( NRADRES == 0 )THEN
+      WRITE(NULOUT,'("SUECRAD: NRADRES NOT SET OR DEFAULT FOUND,NSMAX=",I4)')NSMAX
+      CALL ABOR1('SUECRAD: NRADRES NOT SET OR DEFAULT FOUND')
+    ENDIF
+
+! test if no interpolation is required
+    IF( NRADINT > 0 .AND. NRADRES == NSMAX )THEN
+      WRITE(NULOUT,'("SUECRAD: NRADINT > 0 .AND. NRADRES = NSMAX, NRADINT RESET TO 0")')
+      NRADINT=0
+      GOTO 100
+    ENDIF
+
+!    CALL GSTATS(1818,0)       MPL 2.12.08
+    IF( CRTABLEFIL == 'not set' )THEN
+      IF( LLINEAR_GRID )THEN
+        IF( NRADRES < 1000 )THEN
+          WRITE(CRTABLEFIL,'("rtablel_2",I3.3)')NRADRES
+        ELSE
+          WRITE(CRTABLEFIL,'("rtablel_2",I4.4)')NRADRES
+        ENDIF
+      ELSE
+        IF( NRADRES < 1000 )THEN
+          WRITE(CRTABLEFIL,'("rtable_2" ,I3.3)')NRADRES
+        ELSE
+          WRITE(CRTABLEFIL,'("rtable_2" ,I4.4)')NRADRES
+        ENDIF
+      ENDIF
+    ENDIF
+!    CALL GSTATS(1818,1)       MPL 2.12.08
+
+    RADGRID%NSMAX=NRADRES
+
+    IF( MYPROC == JPIOMASTER )THEN
+      IDIR=LEN_TRIM(CRTABLEDIR)
+      IFIL=LEN_TRIM(CRTABLEFIL)
+      CLFN=CRTABLEDIR(1:IDIR)//CRTABLEFIL(1:IFIL)
+! Ce qui concerne NULRAD commente par MPL le 15.04.09
+!     OPEN(NULRAD,FILE=CLFN,ACTION="READ",ERR=999)
+!     GOTO 1000
+!     999 CONTINUE
+!     WRITE(NULOUT,'("SUECRAD: UNABLE TO OPEN FILE ",A)')CLFN
+!     CALL ABOR1('SUECRAD: UNABLE TO OPEN RADIATION GRID RTABLE FILE')
+!     1000 CONTINUE
+      NRGRI(:)=0
+! Ce qui concerne NAMRGRI commente par MPL le 15.04.09
+!     CALL POSNAM(NULRAD,'NAMRGRI')
+!     READ (NULRAD,NAMRGRI)
+      IDGL=1
+      DO WHILE( NRGRI(IDGL)>0 )
+        IF( LLDEBUG )THEN
+          WRITE(NULOUT,'("SUECRAD: NRGRI(",I4,")=",I4)')IDGL,NRGRI(IDGL)
+        ENDIF
+        IDGL=IDGL+1
+      ENDDO
+      IDGL=IDGL-1
+      RADGRID%NDGLG=IDGL
+      IF( LLDEBUG )THEN
+        WRITE(NULOUT,'("SUECRAD: RADGRID%NDGLG=",I4)')RADGRID%NDGLG
+      ENDIF
+!     CLOSE(NULRAD)
+    ENDIF
+!    CALL GSTATS(667,0)     MPL 2.12.08
+    IF( NPROC > 1 )THEN
+      stop 'Pas pret pour proc > 1'
+!     CALL MPL_BROADCAST (RADGRID%NDGLG,MTAGRAD,JPIOMASTER,CDSTRING='SUECRAD:')
+    ENDIF
+    ALLOCATE(RADGRID%NRGRI(RADGRID%NDGLG))
+    IF( MYPROC == JPIOMASTER )THEN
+      RADGRID%NRGRI(1:RADGRID%NDGLG)=NRGRI(1:RADGRID%NDGLG)
+    ENDIF
+    IF( NPROC > 1 )THEN
+      stop 'Pas pret pour proc > 1'
+!     CALL MPL_BROADCAST (RADGRID%NRGRI(1:RADGRID%NDGLG),MTAGRAD,JPIOMASTER,CDSTRING='SUECRAD:')
+    ENDIF
+!    CALL GSTATS(667,1)      MPL 2.12.08
+
+!    CALL GSTATS(1818,0)     MPL 2.12.08
+    IF    ( NRADINT == 1 )THEN
+      WRITE(NULOUT,'("SUECRAD: INTERPOLATION METHOD - SPECTRAL TRANSFORM")')
+      RADGRID%NDGSUR=0
+      NRIWIDEN=0
+      NRIWIDES=0
+      NRIWIDEW=0
+      NRIWIDEE=0
+      NROWIDEN=0
+      NROWIDES=0
+      NROWIDEW=0
+      NROWIDEE=0
+    ELSEIF( NRADINT == 2 )THEN
+      WRITE(NULOUT,'("SUECRAD: INTERPOLATION METHOD - 4 POINT")')
+      RADGRID%NDGSUR=2
+    ELSEIF( NRADINT == 3 )THEN
+      WRITE(NULOUT,'("SUECRAD: INTERPOLATION METHOD - 12 POINT")')
+      RADGRID%NDGSUR=2
+    ENDIF
+    WRITE(NULOUT,'("SUECRAD: RADGRID%NDGSUR       =",I8)')RADGRID%NDGSUR
+
+    RADGRID%NDGSAG=1-RADGRID%NDGSUR
+    RADGRID%NDGENG=RADGRID%NDGLG+RADGRID%NDGSUR
+    RADGRID%NDLON=RADGRID%NRGRI(RADGRID%NDGLG/2)
+    WRITE(NULOUT,'("SUECRAD: RADGRID%NDGSAG       =",I8)')RADGRID%NDGSAG
+    WRITE(NULOUT,'("SUECRAD: RADGRID%NDGENG       =",I8)')RADGRID%NDGENG
+    WRITE(NULOUT,'("SUECRAD: RADGRID%NDGLG        =",I8)')RADGRID%NDGLG
+    WRITE(NULOUT,'("SUECRAD: RADGRID%NDLON        =",I8)')RADGRID%NDLON
+    CALL FLUSH(NULOUT)
+
+    ALLOCATE(RADGRID%NLOENG(RADGRID%NDGSAG:RADGRID%NDGENG))
+    RADGRID%NLOENG(1:RADGRID%NDGLG)=RADGRID%NRGRI(1:RADGRID%NDGLG)
+    IF(RADGRID%NDGSUR >= 1)THEN
+      DO JGLSUR=1,RADGRID%NDGSUR
+        RADGRID%NLOENG(1-JGLSUR)=RADGRID%NLOENG(JGLSUR)
+      ENDDO
+      DO JGLSUR=1,RADGRID%NDGSUR
+        RADGRID%NLOENG(RADGRID%NDGLG+JGLSUR)=RADGRID%NLOENG(RADGRID%NDGLG+1-JGLSUR)
+      ENDDO
+    ENDIF
+!     CALL GSTATS(1818,1)     MPL 2.12.08
+
+! Setup the transform package for the radiation grid
+    CALL SETUP_TRANS (KSMAX=RADGRID%NSMAX, &
+     & KDGL=RADGRID%NDGLG, &
+     & KLOEN=RADGRID%NLOENG(1:RADGRID%NDGLG), &
+     & LDLINEAR_GRID=LLINEAR_GRID, &
+     & LDSPLIT=LSPLIT, &
+     & KAPSETS=NAPSETS, &
+     & KRESOL=RADGRID%NRESOL_ID)
+
+    ALLOCATE(RADGRID%NSTA(RADGRID%NDGSAG:RADGRID%NDGENG+N_REGIONS_NS-1,N_REGIONS_EW))
+    ALLOCATE(RADGRID%NONL(RADGRID%NDGSAG:RADGRID%NDGENG+N_REGIONS_NS-1,N_REGIONS_EW))
+    ALLOCATE(RADGRID%NPTRFRSTLAT(N_REGIONS_NS))
+    ALLOCATE(RADGRID%NFRSTLAT(N_REGIONS_NS))
+    ALLOCATE(RADGRID%NLSTLAT(N_REGIONS_NS))
+    ALLOCATE(RADGRID%RMU(RADGRID%NDGSAG:RADGRID%NDGENG))
+    ALLOCATE(RADGRID%RSQM2(RADGRID%NDGSAG:RADGRID%NDGENG))
+    ALLOCATE(RADGRID%RLATIG(RADGRID%NDGSAG:RADGRID%NDGENG))
+
+! Interrogate the transform package for the radiation grid
+!    CALL GSTATS(1818,0)    MPL 2.12.08
+    CALL TRANS_INQ (KRESOL     =RADGRID%NRESOL_ID, &
+     & KSPEC2     =RADGRID%NSPEC2, &
+     & KNUMP      =RADGRID%NUMP, &
+     & KGPTOT     =RADGRID%NGPTOT, &
+     & KGPTOTG    =RADGRID%NGPTOTG, &
+     & KGPTOTMX   =RADGRID%NGPTOTMX, &
+     & KPTRFRSTLAT=RADGRID%NPTRFRSTLAT, &
+     & KFRSTLAT   =RADGRID%NFRSTLAT, &
+     & KLSTLAT    =RADGRID%NLSTLAT, &
+     & KFRSTLOFF  =RADGRID%NFRSTLOFF, &
+     & KSTA       =RADGRID%NSTA(1:RADGRID%NDGLG+N_REGIONS_NS-1,:), &
+     & KONL       =RADGRID%NONL(1:RADGRID%NDGLG+N_REGIONS_NS-1,:), &
+     & KPTRFLOFF  =RADGRID%NPTRFLOFF, &
+     & PMU        =RADGRID%RMU(1:) )  
+
+    IF( NRADINT == 2 .OR. NRADINT == 3 )THEN
+      DO JGL=1,RADGRID%NDGLG
+        RADGRID%RSQM2(JGL) = SQRT(1.0_JPRB - RADGRID%RMU(JGL)*RADGRID%RMU(JGL))
+        RADGRID%RLATIG(JGL) = ASIN(RADGRID%RMU(JGL))
+!       WRITE(NULOUT,'("SUECRAD: JGL=",I6," RADGRID%RLATIG=",F10.3)')&
+!        & JGL,RADGRID%RLATIG(JGL)
+      ENDDO
+      IF(RADGRID%NDGSUR >= 1)THEN
+        DO JGLSUR=1,RADGRID%NDGSUR
+          RADGRID%RMU(1-JGLSUR)=RADGRID%RMU(JGLSUR)
+          RADGRID%RSQM2(1-JGLSUR)=RADGRID%RSQM2(JGLSUR)
+          RADGRID%RLATIG(1-JGLSUR)=RPI-RADGRID%RLATIG(JGLSUR)
+        ENDDO
+        DO JGLSUR=1,RADGRID%NDGSUR
+          RADGRID%RMU(RADGRID%NDGLG+JGLSUR)=RADGRID%RMU(RADGRID%NDGLG+1-JGLSUR)
+          RADGRID%RSQM2(RADGRID%NDGLG+JGLSUR)=RADGRID%RSQM2(RADGRID%NDGLG+1-JGLSUR)
+          RADGRID%RLATIG(RADGRID%NDGLG+JGLSUR)=-RPI-RADGRID%RLATIG(RADGRID%NDGLG+1-JGLSUR)
+        ENDDO
+      ENDIF
+    ENDIF
+
+    RADGRID%NDGSAL=1
+    RADGRID%NDGENL=RADGRID%NLSTLAT(MY_REGION_NS)-RADGRID%NFRSTLOFF
+    RADGRID%NDSUR1=3-MOD(RADGRID%NDLON,2)
+    IDLSUR=MAX(RADGRID%NDLON,2*RADGRID%NSMAX+1)
+    RADGRID%NDLSUR=IDLSUR+RADGRID%NDSUR1
+    RADGRID%MYFRSTACTLAT=RADGRID%NFRSTLAT(MY_REGION_NS)
+    RADGRID%MYLSTACTLAT=RADGRID%NLSTLAT(MY_REGION_NS)
+
+    WRITE(NULOUT,'("SUECRAD: RADGRID%NRESOL_ID    =",I8)')RADGRID%NRESOL_ID
+    WRITE(NULOUT,'("SUECRAD: RADGRID%NSMAX        =",I8)')RADGRID%NSMAX
+    WRITE(NULOUT,'("SUECRAD: RADGRID%NSPEC2       =",I8)')RADGRID%NSPEC2
+    WRITE(NULOUT,'("SUECRAD: RADGRID%NGPTOT       =",I8)')RADGRID%NGPTOT
+    WRITE(NULOUT,'("SUECRAD: RADGRID%NGPTOTG      =",I8)')RADGRID%NGPTOTG
+    WRITE(NULOUT,'("SUECRAD: RADGRID%NDGSAL       =",I8)')RADGRID%NDGSAL
+    WRITE(NULOUT,'("SUECRAD: RADGRID%NDGENL       =",I8)')RADGRID%NDGENL
+    WRITE(NULOUT,'("SUECRAD: RADGRID%NDSUR1       =",I8)')RADGRID%NDSUR1
+    WRITE(NULOUT,'("SUECRAD: RADGRID%NDLSUR       =",I8)')RADGRID%NDLSUR
+    WRITE(NULOUT,'("SUECRAD: RADGRID%MYFRSTACTLAT =",I8)')RADGRID%MYFRSTACTLAT
+    WRITE(NULOUT,'("SUECRAD: RADGRID%MYLSTACTLAT  =",I8)')RADGRID%MYLSTACTLAT
+    CALL FLUSH(NULOUT)
+
+    ALLOCATE(RADGRID%NASM0(0:RADGRID%NSPEC2))
+    ALLOCATE(RADGRID%MYMS(RADGRID%NUMP))
+    CALL TRANS_INQ (KRESOL     =RADGRID%NRESOL_ID, &
+     & KASM0      =RADGRID%NASM0, &
+     & KMYMS      =RADGRID%MYMS )  
+
+    ALLOCATE(RADGRID%GELAM(RADGRID%NGPTOT))
+    ALLOCATE(RADGRID%GELAT(RADGRID%NGPTOT))
+    ALLOCATE(RADGRID%GESLO(RADGRID%NGPTOT))
+    ALLOCATE(RADGRID%GECLO(RADGRID%NGPTOT))
+    ALLOCATE(RADGRID%GEMU (RADGRID%NGPTOT))
+
+    IOFF=0
+    ILAT=RADGRID%NPTRFLOFF
+    DO JGLAT=RADGRID%NFRSTLAT(MY_REGION_NS), &
+       & RADGRID%NLSTLAT(MY_REGION_NS)  
+      ZGEMU=RADGRID%RMU(JGLAT)
+      ILAT=ILAT+1
+      ISTLON  = RADGRID%NSTA(ILAT,MY_REGION_EW)
+      IENDLON = ISTLON-1 + RADGRID%NONL(ILAT,MY_REGION_EW)
+
+      DO JLON=ISTLON,IENDLON
+        ZLON=  REAL(JLON-1,JPRB)*2.0_JPRB*RPI &
+         & /REAL(RADGRID%NLOENG(JGLAT),JPRB)  
+        IOFF=IOFF+1
+        RADGRID%GELAM(IOFF) = ZLON
+        RADGRID%GELAT(IOFF) = ASIN(ZGEMU)
+        RADGRID%GESLO(IOFF) = SIN(ZLON)
+        RADGRID%GECLO(IOFF) = COS(ZLON)
+        RADGRID%GEMU (IOFF) = ZGEMU
+      ENDDO
+    ENDDO
+
+    IF( NRADINT == 2 .OR. NRADINT == 3 )THEN
+
+!   For grid point interpolations we need to calculate the halo size
+!   required by each processor
+
+      ALLOCATE(ZLATX(RADGRID%NGPTOTMX))
+      ALLOCATE(ZLONX(RADGRID%NGPTOTMX))
+      DO J=1,RADGRID%NGPTOT
+        ZLATX(J)=RADGRID%GELAT(J)/RPI*2.0_JPRB*90.0
+        ZLONX(J)=(RADGRID%GELAM(J)-RPI)/RPI*180.0
+      ENDDO
+      ZMINRADLAT=MINVAL(ZLATX(1:RADGRID%NGPTOT))
+      ZMAXRADLAT=MAXVAL(ZLATX(1:RADGRID%NGPTOT))
+      ZMINRADLON=MINVAL(ZLONX(1:RADGRID%NGPTOT))
+      ZMAXRADLON=MAXVAL(ZLONX(1:RADGRID%NGPTOT))
+      IF( LLDEBUG )THEN
+        WRITE(NULOUT,'("RADGRID,BEGIN")')
+        IF( MYPROC /= 1 )THEN
+          stop 'Pas pret pour proc > 1'
+!         CALL MPL_SEND(RADGRID%NGPTOT,KDEST=NPRCIDS(1),KTAG=1,CDSTRING='SUECRAD.R')
+!         CALL MPL_SEND(ZLATX(1:RADGRID%NGPTOT),KDEST=NPRCIDS(1),KTAG=2,CDSTRING='SUECRAD.R')
+!         CALL MPL_SEND(ZLONX(1:RADGRID%NGPTOT),KDEST=NPRCIDS(1),KTAG=3,CDSTRING='SUECRAD.R')
+        ENDIF
+        IF( MYPROC == 1 )THEN
+          DO JROC=1,NPROC
+            IF( JROC == MYPROC )THEN
+              DO J=1,RADGRID%NGPTOT
+                WRITE(NULOUT,'(F7.2,2X,F7.2,2X,I6)')ZLATX(J),ZLONX(J),MYPROC
+              ENDDO
+            ELSE
+              stop 'Pas pret pour proc > 1'
+!             CALL MPL_RECV(IGPTOT,KSOURCE=NPRCIDS(JROC),KTAG=1,CDSTRING='SUECRAD.M')
+!             CALL MPL_RECV(ZLATX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=2,CDSTRING='SUECRAD.M')
+!             CALL MPL_RECV(ZLONX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=3,CDSTRING='SUECRAD.M')
+              DO J=1,IGPTOT
+                WRITE(NULOUT,'(F7.2,2X,F7.2,2X,I6)')ZLATX(J),ZLONX(J),JROC
+              ENDDO
+            ENDIF
+          ENDDO
+        ENDIF
+        WRITE(NULOUT,'("RADGRID,END")')
+      ENDIF
+      DEALLOCATE(ZLATX)
+      DEALLOCATE(ZLONX)
+  
+      ALLOCATE(ZLATX(NGPTOTMX))
+      ALLOCATE(ZLONX(NGPTOTMX))
+      DO J=1,NGPTOT
+        ZLATX(J)=GELAT(J)/RPI*2.0_JPRB*90.0
+        ZLONX(J)=(GELAM(J)-RPI)/RPI*180.0
+      ENDDO
+      ZMINMDLLAT=MINVAL(ZLATX(1:NGPTOT))
+      ZMAXMDLLAT=MAXVAL(ZLATX(1:NGPTOT))
+      ZMINMDLLON=MINVAL(ZLONX(1:NGPTOT))
+      ZMAXMDLLON=MAXVAL(ZLONX(1:NGPTOT))
+      IF( LLDEBUG )THEN
+        WRITE(NULOUT,'("MODELGRID,BEGIN")')
+        IF( MYPROC /= 1 )THEN
+          stop 'Pas pret pour proc > 1'
+!         CALL MPL_SEND(NGPTOT,KDEST=NPRCIDS(1),KTAG=1,CDSTRING='SUECRAD')
+!         CALL MPL_SEND(ZLATX(1:NGPTOT),KDEST=NPRCIDS(1),KTAG=2,CDSTRING='SUECRAD')
+!         CALL MPL_SEND(ZLONX(1:NGPTOT),KDEST=NPRCIDS(1),KTAG=3,CDSTRING='SUECRAD')
+!         CALL MPL_SEND(NGLOBALINDEX(1:NGPTOT),KDEST=NPRCIDS(1),KTAG=4,CDSTRING='SUECRAD')
+        ENDIF
+        IF( MYPROC == 1 )THEN
+          DO JROC=1,NPROC
+            IF( JROC == MYPROC )THEN
+              DO J=1,NGPTOT
+                WRITE(NULOUT,'(F7.2,2X,F7.2,2X,I6,2X,I12)')ZLATX(J),ZLONX(J),MYPROC,NGLOBALINDEX(J)
+              ENDDO
+            ELSE
+              stop 'Pas pret pour proc > 1'
+!             CALL MPL_RECV(IGPTOT,KSOURCE=NPRCIDS(JROC),KTAG=1,CDSTRING='SUECRAD')
+!             CALL MPL_RECV(ZLATX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=2,CDSTRING='SUECRAD')
+!             CALL MPL_RECV(ZLONX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=3,CDSTRING='SUECRAD')
+              ALLOCATE(IGLOBALINDEX(1:IGPTOT))
+!             CALL MPL_RECV(IGLOBALINDEX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=4,CDSTRING='SUECRAD')
+              DO J=1,IGPTOT
+                WRITE(NULOUT,'(F7.2,2X,F7.2,2X,I6,2X,I12)')ZLATX(J),ZLONX(J),JROC,IGLOBALINDEX(J)
+              ENDDO
+              DEALLOCATE(IGLOBALINDEX)
+            ENDIF
+          ENDDO
+        ENDIF
+        WRITE(NULOUT,'("MODELGRID,END")')
+      ENDIF
+      DEALLOCATE(ZLATX)
+      DEALLOCATE(ZLONX)
+  
+      IF( LLDEBUG )THEN
+        WRITE(NULOUT,'("ZMINRADLAT=",F10.2)')ZMINRADLAT
+        WRITE(NULOUT,'("ZMINMDLLAT=",F10.2)')ZMINMDLLAT
+        WRITE(NULOUT,'("ZMAXRADLAT=",F10.2)')ZMAXRADLAT
+        WRITE(NULOUT,'("ZMAXMDLLAT=",F10.2)')ZMAXMDLLAT
+        WRITE(NULOUT,'("ZMINRADLON=",F10.2)')ZMINRADLON
+        WRITE(NULOUT,'("ZMINMDLLON=",F10.2)')ZMINMDLLON
+        WRITE(NULOUT,'("ZMAXRADLON=",F10.2)')ZMAXRADLON
+        WRITE(NULOUT,'("ZMAXMDLLON=",F10.2)')ZMAXMDLLON
+      ENDIF
+
+      ZLAT=NDGLG/180.
+      ILATS_DIFF_C=CEILING(ABS(ZMINRADLAT-ZMINMDLLAT)*ZLAT)
+      ILATS_DIFF_F=FLOOR  (ABS(ZMINRADLAT-ZMINMDLLAT)*ZLAT)
+      IF( ZMINRADLAT < ZMINMDLLAT )THEN
+        NRIWIDES=JP_MIN_HALO+ILATS_DIFF_C
+      ELSE
+        NRIWIDES=MAX(0,JP_MIN_HALO-ILATS_DIFF_F)
+      ENDIF
+      ILATS_DIFF_C=CEILING(ABS(ZMAXRADLAT-ZMAXMDLLAT)*ZLAT)
+      ILATS_DIFF_F=FLOOR  (ABS(ZMAXRADLAT-ZMAXMDLLAT)*ZLAT)
+      IF( ZMAXRADLAT < ZMAXMDLLAT )THEN
+        NRIWIDEN=MAX(0,JP_MIN_HALO-ILATS_DIFF_F)
+      ELSE
+        NRIWIDEN=JP_MIN_HALO+ILATS_DIFF_C
+      ENDIF
+      ILATS_DIFF_C=CEILING(ABS(ZMINRADLON-ZMINMDLLON)*ZLAT)
+      ILATS_DIFF_F=FLOOR  (ABS(ZMINRADLON-ZMINMDLLON)*ZLAT)
+      IF( ZMINRADLON < ZMINMDLLON )THEN
+        NRIWIDEW=JP_MIN_HALO+ILATS_DIFF_C
+      ELSE
+        NRIWIDEW=MAX(0,JP_MIN_HALO-ILATS_DIFF_F)
+      ENDIF
+      ILATS_DIFF_C=CEILING(ABS(ZMAXRADLON-ZMAXMDLLON)*ZLAT)
+      ILATS_DIFF_F=FLOOR  (ABS(ZMAXRADLON-ZMAXMDLLON)*ZLAT)
+      IF( ZMAXRADLON < ZMAXMDLLON )THEN
+        NRIWIDEE=MAX(0,JP_MIN_HALO-ILATS_DIFF_F)
+      ELSE
+        NRIWIDEE=JP_MIN_HALO+ILATS_DIFF_C
+      ENDIF
+
+      ZLAT=RADGRID%NDGLG/180.
+      ILATS_DIFF_C=CEILING(ABS(ZMINRADLAT-ZMINMDLLAT)*ZLAT)
+      ILATS_DIFF_F=FLOOR  (ABS(ZMINRADLAT-ZMINMDLLAT)*ZLAT)
+      IF( ZMINMDLLAT < ZMINRADLAT )THEN
+        NROWIDES=JP_MIN_HALO+ILATS_DIFF_C
+      ELSE
+        NROWIDES=MAX(0,JP_MIN_HALO-ILATS_DIFF_F)
+      ENDIF
+      ILATS_DIFF_C=CEILING(ABS(ZMAXRADLAT-ZMAXMDLLAT)*ZLAT)
+      ILATS_DIFF_F=FLOOR  (ABS(ZMAXRADLAT-ZMAXMDLLAT)*ZLAT)
+      IF( ZMAXMDLLAT < ZMAXRADLAT )THEN
+        NROWIDEN=MAX(0,JP_MIN_HALO-ILATS_DIFF_F)
+      ELSE
+        NROWIDEN=JP_MIN_HALO+ILATS_DIFF_C
+      ENDIF
+      ILATS_DIFF_C=CEILING(ABS(ZMINRADLON-ZMINMDLLON)*ZLAT)
+      ILATS_DIFF_F=FLOOR  (ABS(ZMINRADLON-ZMINMDLLON)*ZLAT)
+      IF( ZMINMDLLON < ZMINRADLON )THEN
+        NROWIDEW=JP_MIN_HALO+ILATS_DIFF_C
+      ELSE
+        NROWIDEW=MAX(0,JP_MIN_HALO-ILATS_DIFF_F)
+      ENDIF
+      ILATS_DIFF_C=CEILING(ABS(ZMAXRADLON-ZMAXMDLLON)*ZLAT)
+      ILATS_DIFF_F=FLOOR  (ABS(ZMAXRADLON-ZMAXMDLLON)*ZLAT)
+      IF( ZMAXMDLLON < ZMAXRADLON )THEN
+        NROWIDEE=MAX(0,JP_MIN_HALO-ILATS_DIFF_F)
+      ELSE
+        NROWIDEE=JP_MIN_HALO+ILATS_DIFF_C
+      ENDIF
+
+    ENDIF
+
+    RADGRID%NDGSAH=MAX(RADGRID%NDGSAG,&
+     & RADGRID%NDGSAL+RADGRID%NFRSTLOFF-NROWIDEN)-RADGRID%NFRSTLOFF  
+    RADGRID%NDGENH=MIN(RADGRID%NDGENG,&
+     & RADGRID%NDGENL+RADGRID%NFRSTLOFF+NROWIDES)-RADGRID%NFRSTLOFF  
+    WRITE(NULOUT,'("SUECRAD: RADGRID%NDGSAH       =",I8)')RADGRID%NDGSAH
+    WRITE(NULOUT,'("SUECRAD: RADGRID%NDGENH       =",I8)')RADGRID%NDGENH
+
+    IF( NRADINT == 2 .OR. NRADINT == 3 )THEN
+
+      ILBRLATI = MAX(RADGRID%NDGSAG,&
+       & RADGRID%NDGSAL+RADGRID%NFRSTLOFF-NROWIDEN)-RADGRID%NFRSTLOFF  
+      IUBRLATI = MIN(RADGRID%NDGENG,&
+       & RADGRID%NDGENL+RADGRID%NFRSTLOFF+NROWIDES)-RADGRID%NFRSTLOFF  
+      ALLOCATE(RADGRID%RLATI(ILBRLATI:IUBRLATI))
+      ALLOCATE(RADGRID%RIPI0(ILBRLATI:IUBRLATI))
+      ALLOCATE(RADGRID%RIPI1(ILBRLATI:IUBRLATI))
+      ALLOCATE(RADGRID%RIPI2(ILBRLATI:IUBRLATI))
+  
+      DO JGL= ILBRLATI,IUBRLATI
+        IGLGLO=JGL+RADGRID%NFRSTLOFF
+        IF(IGLGLO >= 0.AND.IGLGLO <= RADGRID%NDGLG) THEN
+          ZD1=RADGRID%RLATIG(IGLGLO-1)-RADGRID%RLATIG(IGLGLO)
+          ZD2=RADGRID%RLATIG(IGLGLO-1)-RADGRID%RLATIG(IGLGLO+1)
+          ZD3=RADGRID%RLATIG(IGLGLO-1)-RADGRID%RLATIG(IGLGLO+2)
+          ZD4=RADGRID%RLATIG(IGLGLO  )-RADGRID%RLATIG(IGLGLO+1)
+          ZD5=RADGRID%RLATIG(IGLGLO  )-RADGRID%RLATIG(IGLGLO+2)
+          ZD6=RADGRID%RLATIG(IGLGLO+1)-RADGRID%RLATIG(IGLGLO+2)
+          RADGRID%RIPI0(JGL)=-1.0_JPRB/(ZD1*ZD4*ZD5)
+          RADGRID%RIPI1(JGL)= 1.0_JPRB/(ZD2*ZD4*ZD6)
+          RADGRID%RIPI2(JGL)=-1.0_JPRB/(ZD3*ZD5*ZD6)
+        ENDIF
+        RADGRID%RLATI(JGL)=RADGRID%RLATIG(IGLGLO)
+      ENDDO
+
+      IF( NPROC > 1 )THEN
+        IRIRPTSUR=NGPTOTG
+        IRISPTSUR=2*NGPTOTG
+      ELSE
+        IRIRPTSUR=0
+        IRISPTSUR=0
+      ENDIF
+
+      ALLOCATE(NRISTA(NDGSAL-NRIWIDEN:NDGENL+NRIWIDES))
+      ALLOCATE(NRIONL(NDGSAL-NRIWIDEN:NDGENL+NRIWIDES))
+      ALLOCATE(NRIOFF(NDGSAL-NRIWIDEN:NDGENL+NRIWIDES))
+      ALLOCATE(NRIEXT(1-NDLON:NDLON+NDLON,1-NRIWIDEN:NDGENL+NRIWIDES))
+      ALLOCATE(NRICORE(NGPTOT))
+      ALLOCATE(IRISENDPOS(IRISPTSUR))
+      ALLOCATE(IRIRECVPOS(IRIRPTSUR))
+      ALLOCATE(IRISENDPTR(NPROC+1))
+      ALLOCATE(IRIRECVPTR(NPROC+1))
+      ALLOCATE(IRICOMM(NPROC))
+      ALLOCATE(IRIMAP(4,NDGLG))
+! MPL 1.12.08      
+!     CALL RDCSET('RI',NRIWIDEN,NRIWIDES,NRIWIDEW,NRIWIDEE,&
+!      & IRIRPTSUR,IRISPTSUR,&
+!      & NDGLG,NDLON,NDGSAG,NDGENG,IDUM,IDUM,NDGSAL,NDGENL,&
+!      & NDSUR1,NDLSUR,NDGSUR,NGPTOT,IDUM,&
+!      & NPTRFLOFF,NFRSTLOFF,MYFRSTACTLAT,MYLSTACTLAT,&
+!      & NSTA,NONL,NLOENG,NPTRFRSTLAT,NFRSTLAT,NLSTLAT,&
+!      & RMU,RSQM2,&
+!      & NRISTA,NRIONL,NRIOFF,NRIEXT,NRICORE,NARIB1,&
+!      & NRIPROCS,NRIMPBUFSZ,NRIRPT,NRISPT,&
+!      & IRISENDPOS,IRIRECVPOS,IRISENDPTR,IRIRECVPTR,IRICOMM,IRIMAP,IRIMAPLEN)  
+      CALL ABOR1('JUSTE APRES CALL RDCSET COMMENTE')
+      WRITE(NULOUT,'("SUECRAD: NARIB1=",I12)')NARIB1
+      ALLOCATE(NRISENDPOS(NRISPT))
+      ALLOCATE(NRIRECVPOS(NRIRPT))
+      ALLOCATE(NRISENDPTR(NRIPROCS+1))
+      ALLOCATE(NRIRECVPTR(NRIPROCS+1))
+      ALLOCATE(NRICOMM(NRIPROCS))
+      NRISENDPOS(1:NRISPT)=IRISENDPOS(1:NRISPT)
+      NRIRECVPOS(1:NRIRPT)=IRIRECVPOS(1:NRIRPT)
+      NRISENDPTR(1:NRIPROCS+1)=IRISENDPTR(1:NRIPROCS+1)
+      NRIRECVPTR(1:NRIPROCS+1)=IRIRECVPTR(1:NRIPROCS+1)
+      NRICOMM(1:NRIPROCS)=IRICOMM(1:NRIPROCS)
+      DEALLOCATE(IRISENDPOS)
+      DEALLOCATE(IRIRECVPOS)
+      DEALLOCATE(IRISENDPTR)
+      DEALLOCATE(IRIRECVPTR)
+      DEALLOCATE(IRICOMM)
+      DEALLOCATE(IRIMAP)
+
+      IF( NPROC > 1 )THEN
+        IRORPTSUR=RADGRID%NGPTOTG
+        IROSPTSUR=2*RADGRID%NGPTOTG
+      ELSE
+        IRORPTSUR=0
+        IROSPTSUR=0
+      ENDIF
+
+      ALLOCATE(NROSTA(RADGRID%NDGSAL-NROWIDEN:RADGRID%NDGENL+NROWIDES))
+      ALLOCATE(NROONL(RADGRID%NDGSAL-NROWIDEN:RADGRID%NDGENL+NROWIDES))
+      ALLOCATE(NROOFF(RADGRID%NDGSAL-NROWIDEN:RADGRID%NDGENL+NROWIDES))
+      ALLOCATE(NROEXT(1-RADGRID%NDLON:RADGRID%NDLON+RADGRID%NDLON,&
+       & 1-NROWIDEN:RADGRID%NDGENL+NROWIDES))  
+      ALLOCATE(NROCORE(RADGRID%NGPTOT))
+      ALLOCATE(IROSENDPOS(IROSPTSUR))
+      ALLOCATE(IRORECVPOS(IRORPTSUR))
+      ALLOCATE(IROSENDPTR(NPROC+1))
+      ALLOCATE(IRORECVPTR(NPROC+1))
+      ALLOCATE(IROCOMM(NPROC))
+      ALLOCATE(IROMAP(4,RADGRID%NDGLG))
+! MPL 1.12.08      
+!     CALL RDCSET('RO',NROWIDEN,NROWIDES,NROWIDEW,NROWIDEE,&
+!      & IRORPTSUR,IROSPTSUR,&
+!      & RADGRID%NDGLG,RADGRID%NDLON,RADGRID%NDGSAG,&
+!      & RADGRID%NDGENG,IDUM,IDUM,RADGRID%NDGSAL,RADGRID%NDGENL,&
+!      & RADGRID%NDSUR1,RADGRID%NDLSUR,RADGRID%NDGSUR,RADGRID%NGPTOT,IDUM,&
+!      & RADGRID%NPTRFLOFF,RADGRID%NFRSTLOFF,RADGRID%MYFRSTACTLAT,RADGRID%MYLSTACTLAT,&
+!      & RADGRID%NSTA,RADGRID%NONL,RADGRID%NLOENG,RADGRID%NPTRFRSTLAT,&
+!      & RADGRID%NFRSTLAT,RADGRID%NLSTLAT,&
+!      & RADGRID%RMU,RADGRID%RSQM2,&
+!      & NROSTA,NROONL,NROOFF,NROEXT,NROCORE,NAROB1,&
+!      & NROPROCS,NROMPBUFSZ,NRORPT,NROSPT,&
+!      & IROSENDPOS,IRORECVPOS,IROSENDPTR,IRORECVPTR,IROCOMM,IROMAP,IROMAPLEN)  
+      CALL ABOR1('JUSTE APRES CALL RDCSET COMMENTE')
+      WRITE(NULOUT,'("SUECRAD: NAROB1=",I12)')NAROB1
+      ALLOCATE(NROSENDPOS(NROSPT))
+      ALLOCATE(NRORECVPOS(NRORPT))
+      ALLOCATE(NROSENDPTR(NROPROCS+1))
+      ALLOCATE(NRORECVPTR(NROPROCS+1))
+      ALLOCATE(NROCOMM(NROPROCS))
+      NROSENDPOS(1:NROSPT)=IROSENDPOS(1:NROSPT)
+      NRORECVPOS(1:NRORPT)=IRORECVPOS(1:NRORPT)
+      NROSENDPTR(1:NROPROCS+1)=IROSENDPTR(1:NROPROCS+1)
+      NRORECVPTR(1:NROPROCS+1)=IRORECVPTR(1:NROPROCS+1)
+      NROCOMM(1:NROPROCS)=IROCOMM(1:NROPROCS)
+      DEALLOCATE(IROSENDPOS)
+      DEALLOCATE(IRORECVPOS)
+      DEALLOCATE(IROSENDPTR)
+      DEALLOCATE(IRORECVPTR)
+      DEALLOCATE(IROCOMM)
+      DEALLOCATE(IROMAP)
+
+      IF( LLDEBUG )THEN
+        WRITE(NULOUT,'("")')
+        IRIWIDEMAXN=0
+        IRIWIDEMAXS=0
+        IRIWIDEMAXW=0
+        IRIWIDEMAXE=0
+        IROWIDEMAXN=0
+        IROWIDEMAXS=0
+        IROWIDEMAXW=0
+        IROWIDEMAXE=0
+        IARIB1MAX=0
+        IAROB1MAX=0
+        IWIDE(1)=NRIWIDEN
+        IWIDE(2)=NRIWIDES
+        IWIDE(3)=NRIWIDEW
+        IWIDE(4)=NRIWIDEE
+        IWIDE(5)=NROWIDEN
+        IWIDE(6)=NROWIDES
+        IWIDE(7)=NROWIDEW
+        IWIDE(8)=NROWIDEE
+        IWIDE(9)=NARIB1
+        IWIDE(10)=NAROB1
+        IF( MYPROC /= 1 )THEN
+          stop 'Pas pret pour proc > 1'
+!         CALL MPL_SEND(IWIDE(1:10),KDEST=NPRCIDS(1),KTAG=1,CDSTRING='SUECRAD.W')
+        ENDIF
+        IF( MYPROC == 1 )THEN
+          DO JROC=1,NPROC
+            IF( JROC /= MYPROC )THEN
+              stop 'Pas pret pour proc > 1'
+!             CALL MPL_RECV(IWIDE(1:10),KSOURCE=NPRCIDS(JROC),KTAG=1,CDSTRING='SUECRAD.W')
+            ENDIF
+            WRITE(NULOUT,'("SUECRAD: PROC=",I5,2X,"NRIWIDEN=",I3,2X,"NROWIDEN=",I3 )')&
+             & JROC,IWIDE(1),IWIDE(5)  
+            WRITE(NULOUT,'("SUECRAD: PROC=",I5,2X,"NRIWIDES=",I3,2X,"NROWIDES=",I3 )')&
+             & JROC,IWIDE(2),IWIDE(6)  
+            WRITE(NULOUT,'("SUECRAD: PROC=",I5,2X,"NRIWIDEW=",I3,2X,"NROWIDEW=",I3 )')&
+             & JROC,IWIDE(3),IWIDE(7)  
+            WRITE(NULOUT,'("SUECRAD: PROC=",I5,2X,"NRIWIDEE=",I3,2X,"NROWIDEE=",I3 )')&
+             & JROC,IWIDE(4),IWIDE(8)  
+            WRITE(NULOUT,'("SUECRAD: PROC=",I5,2X,"NARIB1=",I10,2X,"NAROB1=",I10 )')&
+             & JROC,IWIDE(9),IWIDE(10)
+            WRITE(NULOUT,'("")')
+            IF( IWIDE(1) > IRIWIDEMAXN ) IRIWIDEMAXN=IWIDE(1)
+            IF( IWIDE(2) > IRIWIDEMAXS ) IRIWIDEMAXS=IWIDE(2)
+            IF( IWIDE(3) > IRIWIDEMAXW ) IRIWIDEMAXW=IWIDE(3)
+            IF( IWIDE(4) > IRIWIDEMAXE ) IRIWIDEMAXE=IWIDE(4)
+            IF( IWIDE(5) > IROWIDEMAXN ) IROWIDEMAXN=IWIDE(5)
+            IF( IWIDE(6) > IROWIDEMAXS ) IROWIDEMAXS=IWIDE(6)
+            IF( IWIDE(7) > IROWIDEMAXW ) IROWIDEMAXW=IWIDE(7)
+            IF( IWIDE(8) > IROWIDEMAXE ) IROWIDEMAXE=IWIDE(8)
+            IF( IWIDE(9)  > IARIB1MAX  ) IARIB1MAX  =IWIDE(9)
+            IF( IWIDE(10) > IAROB1MAX  ) IAROB1MAX  =IWIDE(10)
+          ENDDO
+          WRITE(NULOUT,'("")')
+          WRITE(NULOUT,'("SUECRAD: NRIWIDEN(MAX)  =",I8)')IRIWIDEMAXN
+          WRITE(NULOUT,'("SUECRAD: NRIWIDES(MAX)  =",I8)')IRIWIDEMAXS
+          WRITE(NULOUT,'("SUECRAD: NRIWIDEW(MAX)  =",I8)')IRIWIDEMAXW
+          WRITE(NULOUT,'("SUECRAD: NRIWIDEE(MAX)  =",I8)')IRIWIDEMAXE
+          WRITE(NULOUT,'("SUECRAD: NROWIDEN(MAX)  =",I8)')IROWIDEMAXN
+          WRITE(NULOUT,'("SUECRAD: NROWIDES(MAX)  =",I8)')IROWIDEMAXS
+          WRITE(NULOUT,'("SUECRAD: NROWIDEW(MAX)  =",I8)')IROWIDEMAXW
+          WRITE(NULOUT,'("SUECRAD: NROWIDEE(MAX)  =",I8)')IROWIDEMAXE
+          WRITE(NULOUT,'("SUECRAD: NARIB1(MAX)    =",I10)')IARIB1MAX
+          WRITE(NULOUT,'("SUECRAD: NAROB1(MAX)    =",I10)')IAROB1MAX
+          WRITE(NULOUT,'("")')
+        ENDIF
+        CALL FLUSH(NULOUT)
+      ENDIF
+
+    ENDIF
+!    CALL GSTATS(1818,1)      MPL 2.12.08
+
+  ELSE
+
+    WRITE(NULOUT,'("SUECRAD: INVALID VALUE FOR NRADINT=",I6)')NRADINT
+    CALL ABOR1('SUECRAD: NRADINT INVALID')
+
+  ENDIF
+
+ENDIF              ! END OF LERADI BLOCK
+
+!      ----------------------------------------------------------------
+
+!*       4.    INITIALIZE RADIATION COEFFICIENTS.
+!              ----------------------------------
+
+RCDAY   = RDAY * RG / RCPD
+DIFF   = 1.66_JPRB
+R10E   = 0.4342945_JPRB
+
+! CALL GSTATS(1818,0)    MPL 2.12.08
+CALL SURDI
+
+IF (NINHOM == 0) THEN
+  RLWINHF=1._JPRB
+  RSWINHF=1._JPRB
+ENDIF
+
+!      ----------------------------------------------------------------
+
+!*       5.    INITIALIZE RADIATION ABSORPTION COEFFICIENTS
+!              --------------------------------------------
+
+!*       5.1.  Initialization routine for RRTM
+!              -------------------------------
+
+CALL SURRTAB
+CALL SURRTPK
+CALL SURRTRF
+CALL SURRTFTR
+
+IF (LRRTM) THEN
+  IF (KLEV > JPLAY) THEN
+    WRITE(UNIT=KULOUT,&
+     & FMT='('' RRTM MAXIMUM NUMBER OF LAYERS IS REACHED'',&
+     & '' CALL ABORT'')')  
+    CALL ABOR1(' ABOR1 CALLED SUECRAD')
+  ENDIF
+    
+! Read the absorption coefficient data and reduce from 256 to 140 g-points
+
+  CALL RRTM_INIT_140GP
+
+  INBLW=16
+
+ELSE
+  INBLW=6
+
+ENDIF
+
+CALL SULWN
+CALL SUSWN   (NTSW, NSW)
+CALL SUCLOPN (NTSW, NSW, KLEV)
+
+!-- routines specific to SRTM
+IF (LSRTM) THEN
+  NTSW=14
+  ISW =14
+  CALL SRTM_INIT
+  CALL SUSRTAER
+  CALL SUSRTCOP
+  WRITE(UNIT=KULOUT,FMT='(''SRTM Configuration'',L8,3I4)')LSRTM,NTSW,ISW,JPGPT
+
+ELSE
+  IF (.NOT.LONEWSW .OR. ((NSW /= 2).AND.(NSW /= 4).AND.(NSW /= 6)) ) THEN
+    WRITE(UNIT=KULOUT,FMT='(''Wrong SW Configuration'',L8,I3)')LONEWSW,NSW
+  ENDIF
+
+  CALL SUSWN   (NTSW,NSW)
+  CALL SUAERSN (NTSW,NSW)
+ENDIF
+WRITE(UNIT=KULOUT,FMT='('' NLW,NTSW,NSW SET EQUAL TO:'',3I3)') INBLW,NTSW,NSW
+
+
+!-- routine specific to the UV processor
+IF (LUVPROC) THEN
+  NUVTIM = NUVTIM * 86400
+  CALL SU_UVRAD ( NUV )
+ENDIF
+
+!      ----------------------------------------------------------------
+
+!*       6.    INITIALIZE AEROSOL OPTICAL PARAMETERS AND DISTRIBUTION
+!              ------------------------------------------------------
+
+!- LW optical properties
+CALL SUAERL
+!- SW optical properties moved above
+!CALL SUAERSN (NTSW,NSW)
+
+!- horizontal distribution      
+CALL SUAERH
+
+!- vertical distribution
+CALL SUAERV ( KLEV  , PETAH,&
+ & CVDAES , CVDAEL , CVDAEU , CVDAED,&
+ & RCTRBGA, RCVOBGA, RCSTBGA, RCAEOPS, RCAEOPL, RCAEOPU,&
+ & RCAEOPD, RCTRPT , RCAEADK, RCAEADM, RCAEROS &
+ & )  
+
+!-- Overlap function (only used if NOVLP=4)
+! Appel supprime par MPL (30042010) car NOVLP=4 pas utilise
+! sinon il faudrait calculer le geopotentiel STZ
+!CALL SUOVLP ( KLEV )
+
+!-- parameters for prognostic aerosols
+CALL SU_AERW
+
+!      ----------------------------------------------------------------
+
+!*       7.    INITIALIZE SATELLITE GEOMETRICAL/RADIOMETRIC PARAMETERS
+!              -------------------------------------------------------
+
+IF (LEPHYS .AND. NMODE > 1) THEN
+  CALL SUSAT
+ENDIF
+!CALL GSTATS(1818,1)   MPL 2.12.08
+
+!      ----------------------------------------------------------------
+
+!*       8.    INITIALIZE CLIMATOLOGICAL OZONE DISTRIBUTION
+!              --------------------------------------------
+!                  (not done here!!!  called from APLPAR as it depends
+!                     on model pressure levels!)
+
+!      ----------------------------------------------------------------
+
+!*       9.    SET UP MODEL CONFIGURATION FOR TIME-SPACE INTERPOLATION
+!              -------------------------------------------------------
+
+ZTSTEP=MAX(TSTEP,1.0_JPRB)
+ZSTPHR=3600._JPRB/ZTSTEP
+IRADFR=NRADFR
+IF(NRADFR < 0) THEN
+  NRADFR=-NRADFR*ZSTPHR+0.5_JPRB
+ENDIF
+NRADPFR=NRADPFR*NRADFR
+IF (MOD(NRADPLA,2) == 0.AND. NRADPLA /= 0) THEN
+  NRADPLA=NRADPLA+1
+ENDIF
+
+IF(NRADUV < 0) THEN
+  NRADUV=-NRADUV*ZSTPHR+0.5_JPRB
+ENDIF
+
+IST1HR=ZSTPHR+0.05_JPRB
+ISTNHR=  NLNGR1H *ZSTPHR+0.05_JPRB
+IF (MOD(3600._JPRB,ZTSTEP) > 0.1_JPRB) THEN
+  801 CONTINUE
+  IST1HR=IST1HR+1
+  IF (MOD(ISTNHR,IST1HR) /= 0) GO TO 801
+ENDIF
+IF (NRADFR == 1) THEN
+  NRADSFR=NRADFR
+ELSE
+  NRADSFR=IST1HR
+ENDIF
+NRADNFR=NRADFR
+
+IF(LRAYFM) THEN
+  NRPROMA=NDLON+6+(1-MOD(NDLON,2))
+ENDIF
+
+!      ----------------------------------------------------------------
+
+!*       10.    ALLOCATE WORK ARRAYS
+!               --------------------
+
+IU = NULOUT
+LLP = NPRINTLEV >= 1.OR. LALLOPR
+
+IF (LEPHYS) THEN
+  ALLOCATE(EMTD(NPROMA,NFLEVG+1,NGPBLKS))
+  IF(LLP)WRITE(IU,9) 'EMTD     ',SIZE(EMTD     ),SHAPE(EMTD     )
+  ALLOCATE(TRSW(NPROMA,NFLEVG+1,NGPBLKS))
+  IF(LLP)WRITE(IU,9) 'TRSW     ',SIZE(TRSW     ),SHAPE(TRSW     )
+  ALLOCATE(EMTC(NPROMA,NFLEVG+1,NGPBLKS))
+  IF(LLP)WRITE(IU,9) 'EMTC     ',SIZE(EMTC     ),SHAPE(EMTC     )
+  ALLOCATE(TRSC(NPROMA,NFLEVG+1,NGPBLKS))
+  IF(LLP)WRITE(IU,9) 'TRSC     ',SIZE(TRSC     ),SHAPE(TRSC     )
+  ALLOCATE(SRSWD(NPROMA,NGPBLKS))
+  IF(LLP)WRITE(IU,9) 'SRSWD    ',SIZE(SRSWD    ),SHAPE(SRSWD    )
+  ALLOCATE(SRLWD(NPROMA,NGPBLKS))
+  IF(LLP)WRITE(IU,9) 'SRLWD    ',SIZE(SRLWD    ),SHAPE(SRLWD    )
+  ALLOCATE(SRSWDCS(NPROMA,NGPBLKS))
+  IF(LLP)WRITE(IU,9) 'SRSWDCS  ',SIZE(SRSWDCS  ),SHAPE(SRSWDCS  )
+  ALLOCATE(SRLWDCS(NPROMA,NGPBLKS))
+  IF(LLP)WRITE(IU,9) 'SRLWDCS  ',SIZE(SRLWDCS  ),SHAPE(SRLWDCS  )
+  ALLOCATE(SRSWDV(NPROMA,NGPBLKS))
+  IF(LLP)WRITE(IU,9) 'SRSWDV   ',SIZE(SRSWDV   ),SHAPE(SRSWDV   )
+  ALLOCATE(SRSWDUV(NPROMA,NGPBLKS))
+  IF(LLP)WRITE(IU,9) 'SRSWDUV  ',SIZE(SRSWDUV  ),SHAPE(SRSWDUV  )
+  ALLOCATE(EDRO(NPROMA,NGPBLKS))
+  IF(LLP)WRITE(IU,9) 'EDRO     ',SIZE(EDRO     ),SHAPE(EDRO     )
+  ALLOCATE(SRSWPAR(NPROMA,NGPBLKS))
+  IF(LLP)WRITE(IU,9) 'SRSWPAR  ',SIZE(SRSWPAR  ),SHAPE(SRSWPAR  )
+  ALLOCATE(SRSWUVB(NPROMA,NGPBLKS))
+  IF(LLP)WRITE(IU,9) 'SRSWUVB  ',SIZE(SRSWUVB  ),SHAPE(SRSWUVB  )
+
+ELSEIF(LMPHYS .AND. (LRAYFM.OR.LRAYFM15)) THEN
+  ALLOCATE(EMTD(NPROMA,NFLEVG+1,NGPBLKS))
+  IF(LLP)WRITE(IU,9) 'EMTD     ',SIZE(EMTD     ),SHAPE(EMTD     )
+  ALLOCATE(TRSW(NPROMA,NFLEVG+1,NGPBLKS))
+  IF(LLP)WRITE(IU,9) 'TRSW     ',SIZE(TRSW     ),SHAPE(TRSW     )
+  ALLOCATE(EMTU(NPROMA,NFLEVG+1,NGPBLKS))
+  IF(LLP)WRITE(IU,9) 'EMTC     ',SIZE(EMTU     ),SHAPE(EMTU     )
+  ALLOCATE(RMOON(NPROMA,NGPBLKS))
+  IF(LLP)WRITE(IU,9) 'RMOON    ',SIZE(RMOON    ),SHAPE(RMOON    )
+ENDIF
+ALLOCATE(SRSWPARC(NPROMA,NGPBLKS))
+IF(LLP)WRITE(IU,9) 'SRSWPARC ',SIZE(SRSWPARC ),SHAPE(SRSWPARC )
+ALLOCATE(SRSWTINC(NPROMA,NGPBLKS))
+IF(LLP)WRITE(IU,9) 'SRSWTINC ',SIZE(SRSWTINC ),SHAPE(SRSWTINC )
+
+9 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8)
+
+!      ----------------------------------------------------------------
+
+!*       10.    PRINT FINAL VALUES.
+!               -------------------
+
+IF (LOUTPUT) THEN
+  WRITE(UNIT=KULOUT,FMT='('' COMMON YOERAD '')')
+  WRITE(UNIT=KULOUT,FMT='('' LERADI  = '',L5 &
+   & ,'' LERAD1H = '',L5,'' LECO2VAR= '',L5,'' LHGHG = '',L5 &
+   & ,'' NLNGR1H = '',I2,'' NRADSFR = '',I2)')&
+   & LERADI,LERAD1H,LECO2VAR,LHGHG,NLNGR1H,NRADSFR  
+  WRITE(UNIT=KULOUT,FMT='('' LEPO3RA  = '',L5,'' YO3%LGP = '',L5 )') LEPO3RA,YO3%LGP
+  WRITE(UNIT=KULOUT,FMT='('' NRADFR  = '',I2 &
+   & ,'' NRADPFR = '',I3 &
+   & ,'' NRADPLA = '',I2 &
+   & ,'' NRINT   = '',I1 &
+   & ,'' NRPROMA = '',I5 &
+   & )')&
+   & NRADFR,NRADPFR,NRADPLA,NRINT, NRPROMA
+  WRITE(UNIT=KULOUT,FMT='('' LERADHS= '',L5 &
+   & ,'' LRRTM = '',L5 &
+   & ,'' LSRTM = '',L5 &
+   & ,'' NMODE = '',I1 &
+   & ,'' NOZOCL= '',I1 &
+   & ,'' NAER  = '',I1 &
+   & ,'' NHINCSOL='',I2 &
+   & )')&
+   & LERADHS,LRRTM,LSRTM,NMODE,NOZOCL,NAER,NHINCSOL
+  IF (.NOT.LHGHG .AND. .NOT.LECO2VAR) WRITE(UNIT=KULOUT,FMT='('' RCCO2= '',E10.3 &
+    &,'' RCCH4= '',E10.3,'' RCN2O= '',E10.3,'' RCCFC11= '',E10.3,'' RCFC12= '',E10.3 &
+    &)')&
+    & RCCO2,RCCH4,RCN2O,RCCFC11,RCCFC12
+  WRITE(UNIT=KULOUT,FMT='('' NINHOM = '',I1 &
+   & ,'' NLAYINH='',I1   &
+   & ,'' RLWINHF='',F4.2 &
+   & ,'' RSWINHF='',F4.2 &
+   & )')&
+   & NINHOM,NLAYINH,RLWINHF,RSWINHF  
+  IF (NPERTAER /= 0 .OR. NPERTOZ /= 0) THEN
+    WRITE(UNIT=KULOUT,FMT='('' NPERTAER= '',I2 &
+   & ,'' LNOTROAER='',L5 &
+   & ,'' NPERTOZ = '',I1 &
+   & ,'' RPERTOZ = '',F5.0 &
+   & )')&
+   & NPERTAER,LNOTROAER,NPERTOZ,RPERTOZ
+  ENDIF
+  WRITE(UNIT=KULOUT,FMT='('' NRADINT = '',I2)')NRADINT
+  WRITE(UNIT=KULOUT,FMT='('' NRADRES = '',I4)')NRADRES
+  WRITE(UNIT=KULOUT,FMT='('' LRADONDEM = '',L5)')LRADONDEM
+  IF( NRADINT > 0 )THEN
+    IDIR=LEN_TRIM(CRTABLEDIR)
+    IFIL=LEN_TRIM(CRTABLEFIL)
+    WRITE(UNIT=KULOUT,FMT='('' CRTABLEDIR = '',A,'' CRTABLEFIL = '',A)')&
+     & CRTABLEDIR(1:IDIR),CRTABLEFIL(1:IFIL)  
+  ENDIF
+  WRITE(UNIT=KULOUT,FMT='('' LCCNL = '',L5 &
+   & ,'' LCCNO = '',L5 &
+   & ,'' RCCNLND= '',F5.0 &
+   & ,'' RCCNSEA= '',F5.0 &
+   & ,'' LE4ALB = '',L5 &
+   &)')&
+   & LCCNL,LCCNO,RCCNLND,RCCNSEA,LE4ALB 
+  IF (LHVOLCA) THEN
+    WRITE(UNIT=KULOUT,FMT='('' HISTORY OF VOLCANIC AEROSOLS= '',L5)')LHVOLCA
+  ENDIF
+  WRITE(UNIT=KULOUT,FMT='('' LONEWSW= '',L5 &
+   & ,'' NRADIP = '',I1 &
+   & ,'' NRADLP = '',I1 &
+   & ,'' NICEOPT= '',I1 &
+   & ,'' NLIQOPT= '',I1 &
+   & ,'' LDIFFC = '',L5 &
+   & )')&
+   & LONEWSW,NRADIP,NRADLP,NICEOPT,NLIQOPT,LDIFFC
+  WRITE(UNIT=KULOUT,FMT='('' WARNING! CLOUD OVERLAP ASSUMPT. IS''&
+   & ,'' NOVLP   = '',I2 &
+   & )')&
+   & NOVLP  
+  IF (LUVPROC) THEN
+    IDAYUV=NUVTIM/86400
+    WRITE(UNIT=KULOUT,FMT='('' LUVPROC = '',L5 &
+   & ,'' LUVTDEP= '',L5 &
+   & ,'' NRADUV = '',I2 &
+   & ,'' NUV = '',I2 &
+   & ,'' NDAYUV = '',I5 &
+   & ,'' RMUZUV = '',E9.3 &
+   & )')&
+   & LUVPROC,LUVTDEP,NRADUV,NUV,IDAYUV,RMUZUV
+    WRITE(UNIT=KULOUT,FMT='('' RUVLAM = '',24F6.1)') (RUVLAM(JUV),JUV=1,NUV) 
+    WRITE(UNIT=KULOUT,FMT='('' JUVLAM = '',24(3X,I1,2X))') (JUVLAM(JUV),JUV=1,NUV) 
+  ENDIF
+  WRITE(UNIT=KULOUT,FMT='('' NMCICA= '',I2 &
+   & )')&
+   & NMCICA
+ENDIF
+
+!     ------------------------------------------------------------------
+
+
+IF (LHOOK) CALL DR_HOOK('SUECRAD',1,ZHOOK_HANDLE)
+END SUBROUTINE SUECRAD
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/suphec.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/suphec.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/suphec.F90	(revision 5133)
@@ -87,5 +87,5 @@
 USE YOM_PHYS_GRID ,ONLY : PHYS_GRID
 USE YOMCT0  , ONLY  : LSCMEC   ,LROUGH   ,REXTZ0M  ,REXTZ0H
-USE vertical_layers_mod, ONLY: ap,bp
+USE lmdz_vertical_layers, ONLY: ap,bp
 
 IMPLICIT NONE
@@ -184,5 +184,5 @@
 VP00=101325.     !!!!! A REVOIR (MPL)
 ZPRES(NFLEVG)=VP00
-! on recupere ap et bp de dyn3d (vertical_layers_mod) MPL 19.05.09
+! on recupere ap et bp de dyn3d (lmdz_vertical_layers) MPL 19.05.09
 ! Attention, VAH et VBH sont inverses, comme les niveaux
 ! plev(l)=PAPRS(klon,nlayer+1-l) de 1 a nlayer (apllmd.F)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/sw.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/sw.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/sw.F90	(revision 5133)
@@ -73,5 +73,5 @@
 !USE YOERAD   , ONLY : NSW
 ! NSW mis dans .def MPL 20140211
-USE write_field_phy
+USE lmdz_writefield_phy, ONLY: writefield_phy
 
 IMPLICIT NONE
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/sw1s.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/sw1s.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/sw1s.F90	(revision 5133)
@@ -72,5 +72,5 @@
 !USE YOERAD   , ONLY : NSW
 ! NSW mis dans .def MPL 20140211
-USE write_field_phy
+USE lmdz_writefield_phy, ONLY: writefield_phy
 
 IMPLICIT NONE
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/swni.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/swni.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/swni.F90	(revision 5133)
@@ -80,5 +80,5 @@
 !--MODIFCODE
 USE YOERDU   , ONLY : REPLOG   ,REPSCQ   ,REPSC
-USE write_field_phy
+USE lmdz_writefield_phy, ONLY: writefield_phy
 
 IMPLICIT NONE
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/swr.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/swr.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/swr.F90	(revision 5133)
@@ -65,5 +65,5 @@
 USE YOECLD   , ONLY : REPSEC
 USE YOEOVLP  , ONLY : RA1OVLP
-USE write_field_phy
+USE lmdz_writefield_phy, ONLY: writefield_phy
 
 IMPLICIT NONE
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/swuvo3.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/swuvo3.F90	(revision 5132)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/swuvo3.F90	(revision 5133)
@@ -58,5 +58,5 @@
 USE YOESW    , ONLY : NEXPO3, REXPO3
 USE YOMJFH   , ONLY : N_VMASS
-USE write_field_phy
+USE lmdz_writefield_phy
 
 IMPLICIT NONE
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/yomhook.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/yomhook.F90	(revision 5133)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/yomhook.F90	(revision 5133)
@@ -0,0 +1,38 @@
+MODULE YOMHOOK
+
+USE PARKIND1  ,ONLY : JPIM     ,JPRB
+
+IMPLICIT NONE
+
+! Used by "hook" function
+! LHOOK = true implies "hook" function will be called
+! Altough initialized to TRUE it will be reset by first call to 
+! DR_HOOK unless we really want to use the hook function
+
+LOGICAL :: LHOOK=.TRUE.
+
+CONTAINS 
+
+SUBROUTINE DR_HOOK(CDNAME,KSWITCH,PKEY)
+CHARACTER(LEN=*), INTENT(IN) :: CDNAME
+INTEGER(KIND=JPIM),        INTENT(IN) :: KSWITCH
+REAL(KIND=JPRB),        INTENT(INOUT) :: PKEY
+IF (KSWITCH.EQ.0) THEN
+!  PRINT *,'--> ON ENTRE DANS: ',CDNAME
+ELSE IF (KSWITCH.EQ.1) THEN
+!  PRINT *,'    ON SORT  DE  : ',CDNAME
+ENDIF
+END SUBROUTINE DR_HOOK
+
+SUBROUTINE C_DRHOOK_PRINT
+
+! subroutine vide MPL 4.12.08
+!INTEGER(KIND=JPIM) ITID, KTID, IPRINT_OPTION, ILEVEL
+!ITID = 0
+!KTID = 0
+!IPRINT_OPTION = 2
+!ILEVEL = 0
+PRINT *,'ON EST DANS C_DRHOOK_PRINT '
+
+END SUBROUTINE C_DRHOOK_PRINT
+END MODULE YOMHOOK
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/yomoml.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/yomoml.F90	(revision 5133)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/yomoml.F90	(revision 5133)
@@ -0,0 +1,205 @@
+MODULE YOMOML
+
+!-- the following system specific omp_lib-module is not always available (e.g. pgf90)
+!! use omp_lib
+
+USE PARKIND1  ,ONLY : JPIM, JPIB
+
+!**SS/18-Feb-2005
+!--Dr.Hook references removed, because these locks may also be
+!  called from within drhook.c itself !! 
+!--Also, there could be considerable & unjustified overhead
+!  when using Dr.Hook in such a low level
+
+!**SS/15-Dec-2005
+!--The size of lock-variables are now OMP_LOCK_KIND as of in OMP_LIB,
+!  and OMP_LOCK_KIND is aliased to OML_LOCK_KIND
+!  OMP_LOCK_KIND is usually 4 in 32-bit addressing mode
+!                           8 in 64-bit addressing mode
+!--M_OML_LOCK changed to M_EVENT and kept as 32-bit int
+!--OML_FUNCT changed to OML_TEST_EVENT
+!--M_LOCK initialized to -1
+!--M_EVENT initialized to 0
+!--Added intent(s)
+!--Support for omp_lib (but not always available)
+!--Locks can now also be set/unset OUTSIDE the parallel regions
+!--Added routine OML_TEST_LOCK (attempts to set lock, but if *un*successful, does NOT  block)
+!--Buffer-zone for M_LOCK; now a vector of 2 elements in case problems/inconsistencies with OMP_LOCK_KIND 4/8
+
+!**SS/22-Feb-2006
+!--Locking routines are doing nothing unless OMP_GET_MAX_THREADS() > 1
+!  This is to avoid unacceptable deadlocks/timeouts with signal handlers when
+!  the only thread receives signal while inside locked region
+!--Affected routines: OML_TEST_LOCK()  --> always receives .TRUE.
+!                     OML_SET_LOCK()   --> sets nothing
+!                     OML_UNSET_LOCK() --> unsets nothing
+!                     OML_INIT_LOCK()  --> inits nothing
+
+!**SS/11-Sep-2006
+!--Added OML_DEBUG feature
+
+IMPLICIT NONE
+
+SAVE
+
+PRIVATE
+
+LOGICAL :: OML_DEBUG = .FALSE.
+!$OMP THREADPRIVATE(OML_DEBUG)
+
+PUBLIC OML_WAIT_EVENT, OML_SET_EVENT, OML_INCR_EVENT, &
+   &   OML_MY_THREAD,  OML_MAX_THREADS , OML_OMP, &
+   &   OML_IN_PARALLEL, OML_TEST_EVENT, &
+   &   OML_UNSET_LOCK, OML_INIT_LOCK, OML_SET_LOCK, OML_DESTROY_LOCK, &
+   &   OML_LOCK_KIND, OML_TEST_LOCK, OML_DEBUG
+
+!-- The following should normally be 4 in 32-bit addressing mode
+!                                    8 in 64-bit addressing mode
+! Since system specific omp_lib-module is not always available (e.g. pgf90)
+! we hardcode OML_LOCK_KIND to JPIB (usually 8) for now
+!!INTEGER(KIND=JPIM), PARAMETER :: OML_LOCK_KIND = OMP_LOCK_KIND
+INTEGER(KIND=JPIM), PARAMETER :: OML_LOCK_KIND = JPIB
+
+!-- Note: Still JPIM !!
+INTEGER(KIND=JPIM) :: M_EVENT = 0
+!$OMP THREADPRIVATE(M_EVENT)
+
+!-- Note: OML_LOCK_KIND, not JPIM !!
+INTEGER(KIND=OML_LOCK_KIND) :: M_LOCK(2) = (/-1, -1/)
+!$OMP THREADPRIVATE(M_LOCK)
+
+CONTAINS
+
+FUNCTION OML_OMP()
+LOGICAL :: OML_OMP
+OML_OMP=.FALSE.
+!$ OML_OMP=.TRUE.
+END FUNCTION OML_OMP
+
+FUNCTION OML_IN_PARALLEL()
+LOGICAL :: OML_IN_PARALLEL
+!$ LOGICAL :: OMP_IN_PARALLEL
+!$ INTEGER(KIND=JPIM) OMP_GET_MAX_THREADS
+OML_IN_PARALLEL=.FALSE.
+!$ OML_IN_PARALLEL=((OMP_GET_MAX_THREADS() > 1).AND.OMP_IN_PARALLEL())
+END FUNCTION OML_IN_PARALLEL
+
+FUNCTION OML_TEST_LOCK(MYLOCK)
+INTEGER(KIND=OML_LOCK_KIND),intent(inout),optional :: MYLOCK
+LOGICAL :: OML_TEST_LOCK
+!$ LOGICAL :: OMP_TEST_LOCK
+!$ INTEGER(KIND=JPIM) OMP_GET_MAX_THREADS
+OML_TEST_LOCK = .TRUE.
+!$ IF(OMP_GET_MAX_THREADS() > 1) THEN
+!$   IF(PRESENT(MYLOCK))THEN
+!$     OML_TEST_LOCK = OMP_TEST_LOCK(MYLOCK)
+!$   ELSE
+!$     OML_TEST_LOCK = OMP_TEST_LOCK(M_LOCK(1))
+!$   ENDIF
+!$ ENDIF
+END FUNCTION OML_TEST_LOCK
+
+SUBROUTINE OML_UNSET_LOCK(MYLOCK)
+INTEGER(KIND=OML_LOCK_KIND),intent(inout),optional :: MYLOCK
+!$ INTEGER(KIND=JPIM) OMP_GET_MAX_THREADS
+!$ IF(OMP_GET_MAX_THREADS() > 1) THEN
+!$   IF(PRESENT(MYLOCK))THEN
+!$     CALL OMP_UNSET_LOCK(MYLOCK)
+!$   ELSE
+!$     CALL OMP_UNSET_LOCK(M_LOCK(1))
+!$   ENDIF
+!$ ENDIF
+END SUBROUTINE OML_UNSET_LOCK
+
+SUBROUTINE OML_SET_LOCK(MYLOCK)
+INTEGER(KIND=OML_LOCK_KIND),intent(inout),optional :: MYLOCK
+!$ INTEGER(KIND=JPIM) OMP_GET_MAX_THREADS
+!$ IF(OMP_GET_MAX_THREADS() > 1) THEN
+!$   IF(PRESENT(MYLOCK))THEN
+!$     CALL OMP_SET_LOCK(MYLOCK)
+!$   ELSE
+!$     CALL OMP_SET_LOCK(M_LOCK(1))
+!$   ENDIF
+!$ ENDIF
+END SUBROUTINE OML_SET_LOCK
+
+SUBROUTINE OML_INIT_LOCK(MYLOCK)
+INTEGER(KIND=OML_LOCK_KIND),intent(inout),optional :: MYLOCK
+!$ INTEGER(KIND=JPIM) OMP_GET_MAX_THREADS
+!$ IF(OMP_GET_MAX_THREADS() > 1) THEN
+!$   IF(PRESENT(MYLOCK))THEN
+!$     CALL OMP_INIT_LOCK(MYLOCK)
+!$   ELSE
+!$     CALL OMP_INIT_LOCK(M_LOCK(1))
+!$   ENDIF
+!$ ENDIF
+END SUBROUTINE OML_INIT_LOCK
+
+SUBROUTINE OML_DESTROY_LOCK(MYLOCK)
+INTEGER(KIND=OML_LOCK_KIND),intent(inout),optional :: MYLOCK
+!$ IF(PRESENT(MYLOCK))THEN
+!$   CALL OMP_DESTROY_LOCK(MYLOCK)
+!$ ELSE
+!$   CALL OMP_DESTROY_LOCK(M_LOCK(1))
+!$ ENDIF
+END SUBROUTINE OML_DESTROY_LOCK
+
+FUNCTION OML_TEST_EVENT(K,MYEVENT)
+LOGICAL :: OML_TEST_EVENT
+INTEGER(KIND=JPIM),intent(in) :: K,MYEVENT
+IF(K.EQ.MYEVENT) THEN
+ OML_TEST_EVENT =.TRUE.
+ELSE
+ OML_TEST_EVENT=.FALSE.
+ENDIF
+END FUNCTION OML_TEST_EVENT
+
+SUBROUTINE OML_WAIT_EVENT(K,MYEVENT)
+INTEGER(KIND=JPIM),intent(in) :: K
+INTEGER(KIND=JPIM),intent(in),OPTIONAL :: MYEVENT
+IF(PRESENT(MYEVENT))THEN
+  DO
+    IF(OML_TEST_EVENT(K,MYEVENT)) EXIT
+  ENDDO
+ELSE
+  DO
+    IF(OML_TEST_EVENT(K,M_EVENT)) EXIT
+  ENDDO
+ENDIF
+END SUBROUTINE OML_WAIT_EVENT
+
+SUBROUTINE OML_SET_EVENT(K,MYEVENT)
+INTEGER(KIND=JPIM),intent(in) :: K
+INTEGER(KIND=JPIM),intent(out),OPTIONAL :: MYEVENT
+IF(PRESENT(MYEVENT))THEN
+  MYEVENT=K
+ELSE
+  M_EVENT=K
+ENDIF
+END SUBROUTINE OML_SET_EVENT
+
+SUBROUTINE OML_INCR_EVENT(K,MYEVENT)
+INTEGER(KIND=JPIM) :: K
+INTEGER(KIND=JPIM),intent(inout),OPTIONAL :: MYEVENT
+IF(PRESENT(MYEVENT))THEN
+  MYEVENT=MYEVENT+K
+ELSE
+  M_EVENT=M_EVENT+K
+ENDIF
+END SUBROUTINE OML_INCR_EVENT
+
+FUNCTION OML_MY_THREAD()
+INTEGER(KIND=JPIM) :: OML_MY_THREAD
+!$ INTEGER(KIND=JPIM) OMP_GET_THREAD_NUM
+OML_MY_THREAD = 1
+!$ OML_MY_THREAD = OMP_GET_THREAD_NUM() + 1
+END FUNCTION OML_MY_THREAD
+
+FUNCTION OML_MAX_THREADS()
+INTEGER(KIND=JPIM) :: OML_MAX_THREADS
+!$ INTEGER(KIND=JPIM) OMP_GET_MAX_THREADS
+OML_MAX_THREADS = 1
+!$ OML_MAX_THREADS = OMP_GET_MAX_THREADS()
+END FUNCTION OML_MAX_THREADS
+
+END MODULE YOMOML
