Philippe 29/05/2018: IO: force EMIS field read/write to 2D

src/MNH/ini_surf_rad.f90

-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2003-2018 CNRS, Meteo-France and Universite Paul Sabatier
 !MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
 !MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
 !MNH_LIC for details. version 1.
@@ -65,7 +65,9 @@ END MODULE MODI_INI_SURF_RAD
 !
 USE MODD_IO_ll, ONLY : TFILEDATA
 !
+USE MODE_FIELD, ONLY: FIND_FIELD_ID_FROM_MNHNAME, TFIELDDATA, TFIELDLIST
 USE MODE_FMREAD
+USE MODE_MSG
 !
 IMPLICIT NONE
 !
@@ -74,16 +76,25 @@ IMPLICIT NONE
 TYPE(TFILEDATA),        INTENT(IN)  :: TPINIFILE ! Initial file
 REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDIR_ALB  ! Direct albedo
 REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSCA_ALB  ! Diffuse albedo
-REAL, DIMENSION(:,:,:),   INTENT(OUT) :: PEMIS     ! emissivity
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEMIS     ! emissivity
 REAL, DIMENSION(:,:),   INTENT(OUT) :: PTSRAD    ! radiative surface temperature
 !
 !*       0.2   declarations of local variables
 !
+INTEGER           :: IID, IRESP
+TYPE(TFIELDDATA)  :: TZFIELD
 !-------------------------------------------------------------------------------
 !
 CALL IO_READ_FIELD(TPINIFILE,'DIR_ALB',PDIR_ALB)
 CALL IO_READ_FIELD(TPINIFILE,'SCA_ALB',PSCA_ALB)
-CALL IO_READ_FIELD(TPINIFILE,'EMIS',PEMIS)
+!
+CALL PRINT_MSG(NVERB_INFO,'IO','INI_SURF_RAD','EMIS: reading only first band (copy on others)')
+CALL FIND_FIELD_ID_FROM_MNHNAME('EMIS',IID,IRESP)
+TZFIELD = TFIELDLIST(IID)
+TZFIELD%NDIMS = 2
+CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PEMIS(:,:,1))
+PEMIS(:,:,:) = SPREAD(SOURCE=PEMIS(:,:,1),DIM=3,NCOPIES=SIZE(PEMIS,3))
+!
 CALL IO_READ_FIELD(TPINIFILE,'TSRAD',PTSRAD)
 !  
 !-------------------------------------------------------------------------------

src/MNH/write_lfifm1_for_diag_supp.f90

@@ -214,7 +214,7 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWAL
 ! variables needed for coarse graining
 REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZUT_PRM,ZVT_PRM,ZWT_PRM
 REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZUU_AVG,ZVV_AVG,ZWW_AVG
-INTEGER :: IDX
+INTEGER :: IDX, IID, IRESP
 CHARACTER(LEN=3) :: YDX
 !-------------------------------------------------------------------------------
 !
@@ -560,7 +560,13 @@ IF (NRAD_3D >= 0) THEN
     CALL IO_WRITE_FIELD(TPFILE,'AZIM',        XAZIM)
     CALL IO_WRITE_FIELD(TPFILE,'DIR_ALB',     XDIR_ALB)
     CALL IO_WRITE_FIELD(TPFILE,'SCA_ALB',     XSCA_ALB)
-    CALL IO_WRITE_FIELD(TPFILE,'EMIS',        XEMIS)
+    !
+    CALL PRINT_MSG(NVERB_INFO,'IO','WRITE_LFIFM1_FOR_DIAG_SUPP','EMIS: writing only first band')
+    CALL FIND_FIELD_ID_FROM_MNHNAME('EMIS',IID,IRESP)
+    TZFIELD = TFIELDLIST(IID)
+    TZFIELD%NDIMS = 2
+    CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XEMIS(:,:,1))
+    !
     CALL IO_WRITE_FIELD(TPFILE,'TSRAD',       XTSRAD)
   ELSE
     PRINT*,'YOU WANT DIAGNOSTICS RELATED TO RADIATION'

src/MNH/write_lfin.f90

@@ -245,6 +245,7 @@ USE MODE_IO_ll, ONLY: UPCASE,CLOSE_ll
 USE MODE_FIELD
 USE MODE_GATHER_ll
 USE MODE_GRIDPROJ
+USE MODE_MSG
 USE MODE_MODELN_HANDLER
 !
 USE MODI_WRITE_LB_n
@@ -1510,7 +1511,13 @@ IF (CRAD /= 'NONE') THEN
   CALL IO_WRITE_FIELD(TPFILE,'AZIM',        XAZIM)
   CALL IO_WRITE_FIELD(TPFILE,'DIR_ALB',     XDIR_ALB)
   CALL IO_WRITE_FIELD(TPFILE,'SCA_ALB',     XSCA_ALB)
-  CALL IO_WRITE_FIELD(TPFILE,'EMIS',        XEMIS)
+  !
+  CALL PRINT_MSG(NVERB_INFO,'IO','WRITE_LFIFM_n','EMIS: writing only first band')
+  CALL FIND_FIELD_ID_FROM_MNHNAME('EMIS',IID,IRESP)
+  TZFIELD = TFIELDLIST(IID)
+  TZFIELD%NDIMS = 2
+  CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XEMIS(:,:,1))
+  !
   CALL IO_WRITE_FIELD(TPFILE,'TSRAD',       XTSRAD)
 ENDIF
 !

src/MNH/write_surf_mnh.f90

@@ -82,6 +82,13 @@ IF (IRESP==0) THEN
     TPFIELD%NTYPE = KTYPE
   END IF
   !Modify and check NDIMS
+  !
+  IF(TPFIELD%CMNHNAME=='EMIS' .AND. TPFIELD%NDIMS/=2) THEN
+    !Special (temporary) treatment for EMIS
+    CALL PRINT_MSG(NVERB_INFO,'IO',TRIM(HSUBR),'NDIMS forced to 2 for EMIS')
+    TPFIELD%NDIMS = 2
+  END IF
+  !
   IF (TPFIELD%NDIMS/=KDIMS) THEN
     WRITE(YTXT,'( I0,"/",I0 )') TPFIELD%NDIMS,KDIMS
     CALL PRINT_MSG(NVERB_WARNING,'IO',TRIM(HSUBR),'NDIMS different ('//TRIM(YTXT) &