Changeset 4853 for LMDZ6/trunk/libf/phylmd/ecrad/radiation/radiation_aerosol_optics_description.F90

Timestamp:

Mar 19, 2024, 3:34:21 PM (2 months ago)

Author:

idelkadi

Message:

Ecrad update in LMDZ / Implementation of Ecrad double call in LMDZ

• version 1.6.1 (commit 210d7911380f53a788c3cad73b3cf9b4e022ef87)
• interface routines between lmdz and ecrad grouped in a new "lmdz" directory
• double call method redesigned so as to go through the Ecrad initialization and configuration part only once for the entire simulation
• clean-up in the read.F routine: delete unitules arguments
• modification of default gas model in namelist (default: ECCKD)

File:

• LMDZ6/trunk/libf/phylmd/ecrad/radiation/radiation_aerosol_optics_description.F90 (modified) (16 diffs)

LMDZ6/trunk/libf/phylmd/ecrad/radiation/radiation_aerosol_optics_description.F90

@@ -13 +13 @@
 ! Email:   r.j.hogan@ecmwf.int
 !
+
+#include "ecrad_config.h"
 
 module radiation_aerosol_optics_description
@@ -60 +62 @@
     logical, allocatable :: is_preferred_philic(:)
 
+    ! Verbosity level
+    integer :: iverbose
+    
   contains
     procedure :: read
@@ -75 +80 @@
 
     use yomhook,              only : lhook, dr_hook, jphook
+#ifdef EASY_NETCDF_READ_MPI
+    use easy_netcdf_read_mpi, only : netcdf_file
+#else
     use easy_netcdf,          only : netcdf_file
+#endif
 
     class(aerosol_optics_description_type), intent(inout) :: this
@@ -84 +93 @@
     type(netcdf_file)  :: file
 
-    real(jphook) :: hook_handle
+    real(jphook)       :: hook_handle
 
     if (lhook) call dr_hook('radiation_aerosol_optics_description:load',0,hook_handle)
@@ -108 +117 @@
     call file%close()
 
+    if (present(iverbose)) then
+      this%iverbose = iverbose
+    else
+      this%iverbose = 3
+    end if
+    
     if (lhook) call dr_hook('radiation_aerosol_optics_description:load',1,hook_handle)
 
@@ -124 +139 @@
 
     use yomhook,              only : lhook, dr_hook, jphook
-
+    use radiation_io,         only : nulout, nulerr, radiation_abort
+    
     class(aerosol_optics_description_type), intent(inout) :: this
     character(len=2), intent(in) :: code_str
@@ -132 +148 @@
     integer :: ja
 
-    real(jphook) :: hook_handle
+    logical :: is_found, is_philic, is_phobic
+
+    real(jphook)         :: hook_handle
 
     if (lhook) call dr_hook('radiation_aerosol_optics_description:preferred_optical_model',0,hook_handle)
@@ -138 +156 @@
     ! Check for empty string
     if (optical_model_str == ' ') then
+      if (lhook) call dr_hook('radiation_aerosol_optics_description:preferred_optical_model',1,hook_handle)
       return
     end if
+
+    is_found  = .false.
+    is_philic = .false.
+    is_phobic = .false.
     
     ! Loop over hydrophilic types
@@ -145 +168 @@
       ! Check if we have a match
       if (to_string(this%code_philic(:,ja)) == code_str &
-           &  .and. to_string(this%optical_model_philic(1:len(optical_model_str),ja)) &
+           &  .and. trim(to_string(this%optical_model_philic(:,ja))) &
            &          == optical_model_str) then
         this%is_preferred_philic(ja) = .true.
+        is_found  = .true.
+        is_philic = .true.
       end if
     end do
@@ -153 +178 @@
     do ja = 1,size(this%bin_phobic)
       if (to_string(this%code_phobic(:,ja)) == code_str &
-           &  .and. to_string(this%optical_model_phobic(1:len(optical_model_str),ja)) &
+           &  .and. trim(to_string(this%optical_model_phobic(:,ja))) &
            &          == optical_model_str) then
         this%is_preferred_phobic(ja) = .true.
+        is_found  = .true.
+        is_phobic = .true.
       end if
     end do
 
+    if (.not. is_found) then
+      write(nulerr,'(a,a2,a,a,a)') '*** Error: Preferred "', code_str ,'" aerosol optical model "', &
+           &  trim(optical_model_str), '" not found in file'
+      call radiation_abort()
+    else if (this%iverbose > 2) then
+      write(nulout,'(a,a2,a,a,a)',advance='no') 'Preferred "', code_str, '" aerosol optical model set to "', &
+           &  trim(optical_model_str), '" ('
+      if (is_phobic) then
+        write(nulout,'(a)',advance='no') ' hydrophobic'
+      end if
+      if (is_philic) then
+        write(nulout,'(a)',advance='no') ' hydrophilic'
+      end if
+      write(nulout,'(a)') ' )'
+    end if
+    
     if (lhook) call dr_hook('radiation_aerosol_optics_description:preferred_optical_model',1,hook_handle)
 
   end subroutine preferred_optical_model
 
+  
   !---------------------------------------------------------------------
   ! Return the index to the aerosol optical properties corresponding
@@ -179 +223 @@
     
     use yomhook,              only : lhook, dr_hook, jphook
-    use easy_netcdf,          only : netcdf_file
     use radiation_io,         only : nulout
 
@@ -234 +277 @@
           end if
           if (present(optical_model_str)) then
-            if (to_string(this%optical_model_philic(1:len(optical_model_str),ja)) &
+            if (trim(to_string(this%optical_model_philic(:,ja))) &
                  &  == optical_model_str) then
               ! Requested optical model matches
@@ -285 +328 @@
           end if
           if (present(optical_model_str)) then
-            if (to_string(this%optical_model_phobic(1:len(optical_model_str),ja)) &
+            if (trim(to_string(this%optical_model_phobic(:,ja))) &
                  &  == optical_model_str) then
               ! Requested optical model matches
@@ -315 +358 @@
 
     if (is_ambiguous) then
-      write(nulout,'(a,a2,a,l1,a)') 'Warning: get_index("', code_str, '",', lhydrophilic, &
+      write(nulout,'(a,a2,a,l,a)') 'Warning: radiation_aerosol_optics_description:get_index("', &
+           &  code_str, '",', lhydrophilic, &
            &  ',...) does not unambiguously identify an aerosol optical property index'
     end if
-
+    
     if (lhook) call dr_hook('radiation_aerosol_optics_description:get_index',1,hook_handle)
 
@@ -325 +369 @@
   !---------------------------------------------------------------------
   ! Utility function to convert an array of single characters to a
-  ! character string (yes Fortran's string handling is a bit rubbish)
+  ! character string (yes Fortran's string handling is a bit
+  ! rubbish). We set NULL characters (ASCII code 0) returned from the
+  ! NetCDF library to spaces, so that TRIM can remove them.
   pure function to_string(arr) result(str)
     character, intent(in)  :: arr(:)
@@ -331 +377 @@
     integer :: jc
     do jc = 1,size(arr)
-      str(jc:jc) = arr(jc)
+      if (ichar(arr(jc)) == 0) then
+        ! Replace NULL character with a space
+        str(jc:jc) = ' '
+      else
+        str(jc:jc) = arr(jc)
+      end if
     end do
   end function to_string