Accumulated changes: readability, streamlined OpenACC and OpenMP, arg…

…ument intents, self-hosted CI from Azure Pipelines to Github Actions,

.github/workflows/self-hosted-ci.yml

@@ -0,0 +1,83 @@
+name: Self-hosted CI
+
+on: [push, pull_request, workflow_dispatch]
+
+jobs:
+  CI:
+    runs-on: daint
+    strategy:
+      matrix:
+        include:
+        - config_name: pgi_default_gpu
+          compiler_base: pgi
+          compiler_module: pgi
+          accel_module: craype-accel-nvidia60
+          # Generic accelerator flag
+          FCFLAGS: "-O3 -acc -Mallocatable=03 -gopt"
+          RTE_KERNELS: openacc
+        - config_name: cce-cpu-icon-production
+          compiler_base: cray
+          compiler_module: cce-icon/11.0.0
+          accel_module: ""
+          # Production flags for Icon model
+          RTE_KERNELS: default
+          FCFLAGS: "-hadd_paren -r am -Ktrap=divz,ovf,inv -hflex_mp=intolerant -hfp1 -hnoacc -O1,cache0"
+        - config_name: cce-openmp
+          compiler_base: cray
+          compiler_module: cce/11.0.0
+          accel_module: craype-accel-nvidia60
+          # OpenMP flags from Nichols Romero (Argonne)
+          FCFLAGS: "-hnoacc -homp -O0"
+          RTE_KERNELS: openacc
+    env:
+      FCFLAGS: ${{ matrix.FCFLAGS }}
+      RTE_KERNELS: ${{ matrix.RTE_KERNELS }}
+      RUN_CMD: "srun -C gpu -A pr55 -p cscsci -t 15:00"
+    steps:
+    - name: Check out code
+      uses: actions/checkout@v2
+    - name: Create module environment
+      run: |
+        set -e
+        echo '
+        module load daint-gpu
+        export PATH=$CRAY_BINUTILS_BIN:$PATH
+        module swap PrgEnv-cray PrgEnv-${{ matrix.compiler_base }}
+        module swap ${{ matrix.compiler_base }} ${{ matrix.compiler_module }}
+        module load ${{ matrix.accel_module }}
+        module load cray-netcdf cray-hdf5
+        export LD_LIBRARY_PATH=$CRAY_LD_LIBRARY_PATH:$LD_LIBRARY_PATH
+        export CUDA_HOME=$CUDATOOLKIT_HOME
+        echo Compiler Environment:
+        module list
+        echo LD_LIBRARY_PATH is:
+        echo $LD_LIBRARY_PATH
+        ' > compiler_modules
+    - name: Stage files
+      run: |
+        set -e
+        cd examples/rfmip-clear-sky
+        source ./stage_files.sh
+    - name: Make
+      run: |
+        set -e
+        source compiler_modules
+        export RRTMGP_ROOT=$PWD
+        export FC=ftn
+        make clean
+        make libs
+    - name: Run
+      run: |
+        set -e
+        source compiler_modules
+        module load cray-python
+        export RRTMGP_ROOT=$PWD
+        make tests
+    - name: Check results
+      run: |
+        set -e
+        module load daint-gpu
+        export RRTMGP_ROOT=$PWD
+        # This module will unload some of the build modules, so do the checks separately
+        module load netcdf-python
+        make check

.gitignore

@@ -7,6 +7,13 @@
 # Object files
 *.o
 
+# Dependency files
+*.d
+
+# Fortran module files
+*.mod
+*.mod.proxy
+
 # Intel vectorization reports
 *.optrpt
 

examples/all-sky/mo_garand_atmos_io.F90

@@ -24,7 +24,6 @@ module mo_garand_atmos_io
   !
   use mo_rte_kind,           only: wp
   use mo_gas_concentrations, only: ty_gas_concs
-  use mo_rrtmgp_util_reorder,only: reorder123x312
   use mo_optical_props,      only: ty_optical_props
   !
   ! NetCDF I/O routines, shared with other RTE+RRTMGP examples
@@ -148,7 +147,7 @@ subroutine stop_on_err(msg)
     character(len=*), intent(in) :: msg
     if(len_trim(msg) > 0) then
       write(error_unit,*) trim(msg)
-      stop
+      error stop 1
     end if
   end subroutine
   !--------------------------------------------------------------------------------------------------------------------

examples/all-sky/mo_load_cloud_coefficients.F90

@@ -180,7 +180,7 @@ subroutine stop_on_err(msg)
       character(len=*), intent(in) :: msg
       if(len_trim(msg) > 0) then
         write (error_unit,*) trim(msg)
-        stop
+        error stop 1
       end if
     end subroutine
 

examples/mo_load_coefficients.F90

@@ -37,7 +37,7 @@ subroutine stop_on_err(msg)
 
     if(msg /= "") then
       write(error_unit, *) msg
-      stop
+      error stop 1
     end if
   end subroutine
   !--------------------------------------------------------------------------------------------------------------------
@@ -128,7 +128,7 @@ subroutine load_and_init(kdist, filename, available_gases)
     ! Read the many arrays
     !
     gas_names         = read_char_vec(ncid, 'gas_names', nabsorbers)
-    key_species       = read_field(ncid, 'key_species',  2, nlayers, nbnds)
+    key_species       = int(read_field(ncid, 'key_species',  2, nlayers, nbnds))
     band_lims         = read_field(ncid, 'bnd_limits_wavenumber', 2, nbnds)
     band2gpt          = int(read_field(ncid, 'bnd_limits_gpt', 2, nbnds))
     press_ref         = read_field(ncid, 'press_ref', npress)
@@ -161,9 +161,9 @@ subroutine load_and_init(kdist, filename, available_gases)
     scaling_gas_upper &
                       = read_char_vec(ncid, 'scaling_gas_upper', nminor_absorber_intervals_upper)
     kminor_start_lower &
-                      = read_field(ncid, 'kminor_start_lower', nminor_absorber_intervals_lower)
+                      = int(read_field(ncid, 'kminor_start_lower', nminor_absorber_intervals_lower))
     kminor_start_upper &
-                      = read_field(ncid, 'kminor_start_upper', nminor_absorber_intervals_upper)
+                      = int(read_field(ncid, 'kminor_start_upper', nminor_absorber_intervals_upper))
     vmr_ref           = read_field(ncid, 'vmr_ref', nlayers, nextabsorbers, ntemps)
 
     kmajor            = read_field(ncid, 'kmajor',  ngpts, nmixingfracs,  npress+1, ntemps)

examples/mo_simple_netcdf.F90

@@ -217,24 +217,6 @@ function write_4d_field(ncid, varName, var) result(err_msg)
 
   end function write_4d_field
   !--------------------------------------------------------------------------------------------------------------------
-  function write_string(ncid, varName, var) result(err_msg)
-    integer,                    intent(in) :: ncid
-    character(len=*),           intent(in) :: varName
-    character(len=*),           intent(in) :: var
-    character(len=128)                     :: err_msg
-
-    integer :: varid
-
-    err_msg = ""
-    if(nf90_inq_varid(ncid, trim(varName), varid) /= NF90_NOERR) then
-      err_msg = "write_field: can't find variable " // trim(varName)
-      return
-    end if
-    if(nf90_put_var(ncid, varid, var)  /= NF90_NOERR) &
-      err_msg = "write_field: can't write variable " // trim(varName)
-
-  end function write_string
-  !--------------------------------------------------------------------------------------------------------------------
   function read_logical_vec(ncid, varName, nx)
     integer,          intent(in) :: ncid
     character(len=*), intent(in) :: varName
@@ -308,7 +290,7 @@ subroutine create_dim(ncid, dimName, dimLength)
     character(len=*), intent(in) :: dimName
     integer,          intent(in) :: dimLength
 
-    integer                 :: i, dimid
+    integer                 :: dimid
 
     if(dim_exists(ncid, dimName)) then
       if (dimLength /= get_dim_size(ncid, trim(dimName))) &
@@ -415,7 +397,7 @@ subroutine stop_on_err(msg)
     character(len=*), intent(in) :: msg
     if(len_trim(msg) > 0) then
       write(error_unit,*) trim(msg)
-      stop
+      error stop 1
     end if
   end subroutine
   !--------------------------------------------------------------------------------------------------------------------

examples/rfmip-clear-sky/mo_rfmip_io.F90

@@ -130,8 +130,10 @@ subroutine read_and_block_sw_bc(fileName, blocksize, &
     integer :: nblocks
     real(wp), dimension(ncol_l, nexp_l) :: temp2D
     ! ---------------------------
-    if(any([ncol_l, nlay_l, nexp_l]  == 0)) call stop_on_err("read_and_block_sw_bc: Haven't read problem size yet.")
-    if(mod(ncol_l*nexp_l, blocksize) /= 0 ) call stop_on_err("read_and_block_sw_bc: number of columns doesn't fit evenly into blocks.")
+    if(any([ncol_l, nlay_l, nexp_l]  == 0)) &
+      call stop_on_err("read_and_block_sw_bc: Haven't read problem size yet.")
+    if(mod(ncol_l*nexp_l, blocksize) /= 0 ) &
+      call stop_on_err("read_and_block_sw_bc: number of columns doesn't fit evenly into blocks.")
     nblocks = (ncol_l*nexp_l)/blocksize
     !
     ! Check that output arrays are sized correctly : blocksize, nlay, (ncol * nexp)/blocksize
@@ -374,7 +376,8 @@ subroutine read_and_block_gases_ty(fileName, blocksize, gas_names, names_in_file
       if(string_in_array(gas_names(g), ['h2o', 'o3 ', 'no2'])) cycle
 
       ! Read the values as a function of experiment
-      gas_conc_temp_1d = read_field(ncid, trim(names_in_file(g)) // "_GM", nexp_l) * read_scaling(ncid, trim(names_in_file(g)) // "_GM")
+      gas_conc_temp_1d = read_field  (ncid, trim(names_in_file(g)) // "_GM", nexp_l) * &
+                         read_scaling(ncid, trim(names_in_file(g)) // "_GM")
 
       do b = 1, nblocks
         ! Does every value in this block belong to the same experiment?
@@ -431,12 +434,15 @@ subroutine unblock_and_write(fileName, varName, values)
     integer :: b, blocksize, nlev, nblocks
     real(wp), dimension(:,:), allocatable :: temp2d
     ! ---------------------------
-    if(any([ncol_l, nlay_l, nexp_l]  == 0)) call stop_on_err("unblock_and_write: Haven't read problem size yet.")
+    if(any([ncol_l, nlay_l, nexp_l]  == 0)) &
+      call stop_on_err("unblock_and_write: Haven't read problem size yet.")
     blocksize = size(values,1)
     nlev      = size(values,2)
     nblocks   = size(values,3)
-    if(nlev /= nlay_l+1)                   call stop_on_err('unblock_and_write: array values has the wrong number of levels')
-    if(blocksize*nblocks /= ncol_l*nexp_l) call stop_on_err('unblock_and_write: array values has the wrong number of blocks/size')
+    if(nlev /= nlay_l+1)                   call &
+      stop_on_err('unblock_and_write: array values has the wrong number of levels')
+    if(blocksize*nblocks /= ncol_l*nexp_l) &
+      call stop_on_err('unblock_and_write: array values has the wrong number of blocks/size')
 
     allocate(temp2D(nlev, ncol_l*nexp_l))
     do b = 1, nblocks
@@ -462,7 +468,7 @@ subroutine stop_on_err(msg)
     character(len=*), intent(in) :: msg
     if(len_trim(msg) > 0) then
       write(error_unit,*) trim(msg)
-      stop
+      error stop 1
     end if
   end subroutine
 end module mo_rfmip_io

extensions/cloud_optics/mo_cloud_optics.F90

@@ -412,28 +412,32 @@ function cloud_optics(this, &
     !
     ! Array sizes
     !
-    if(size(liqmsk,1) /= ncol .or. size(liqmsk,2) /= nlay) &
-      error_msg = "cloud optics: liqmask has wrong extents"
-    if(size(icemsk,1) /= ncol .or. size(icemsk,2) /= nlay) &
-      error_msg = "cloud optics: icemsk has wrong extents"
-    if(size(ciwp,  1) /= ncol .or. size(ciwp,  2) /= nlay) &
-      error_msg = "cloud optics: ciwp has wrong extents"
-    if(size(reliq, 1) /= ncol .or. size(reliq, 2) /= nlay) &
-      error_msg = "cloud optics: reliq has wrong extents"
-    if(size(reice, 1) /= ncol .or. size(reice, 2) /= nlay) &
-      error_msg = "cloud optics: reice has wrong extents"
-    if(optical_props%get_ncol() /= ncol .or. optical_props%get_nlay() /= nlay) &
-      error_msg = "cloud optics: optical_props have wrong extents"
-    if(error_msg /= "") return
+    if (check_extents) then
+      if(size(liqmsk,1) /= ncol .or. size(liqmsk,2) /= nlay) &
+        error_msg = "cloud optics: liqmask has wrong extents"
+      if(size(icemsk,1) /= ncol .or. size(icemsk,2) /= nlay) &
+        error_msg = "cloud optics: icemsk has wrong extents"
+      if(size(ciwp,  1) /= ncol .or. size(ciwp,  2) /= nlay) &
+        error_msg = "cloud optics: ciwp has wrong extents"
+      if(size(reliq, 1) /= ncol .or. size(reliq, 2) /= nlay) &
+        error_msg = "cloud optics: reliq has wrong extents"
+      if(size(reice, 1) /= ncol .or. size(reice, 2) /= nlay) &
+        error_msg = "cloud optics: reice has wrong extents"
+      if(optical_props%get_ncol() /= ncol .or. optical_props%get_nlay() /= nlay) &
+        error_msg = "cloud optics: optical_props have wrong extents"
+      if(error_msg /= "") return
+    end if
 
     !
     ! Spectral consistency
     !
-    if(.not. this%bands_are_equal(optical_props)) &
-      error_msg = "cloud optics: optical properties don't have the same band structure"
-    if(optical_props%get_nband() /= optical_props%get_ngpt() ) &
-      error_msg = "cloud optics: optical properties must be requested by band not g-points"
-    if(error_msg /= "") return
+    if(check_values) then
+      if(.not. this%bands_are_equal(optical_props)) &
+        error_msg = "cloud optics: optical properties don't have the same band structure"
+      if(optical_props%get_nband() /= optical_props%get_ngpt() ) &
+        error_msg = "cloud optics: optical properties must be requested by band not g-points"
+      if(error_msg /= "") return
+    end if
 
     !$acc data copyin(clwp, ciwp, reliq, reice)                         &
     !$acc      create(ltau, ltaussa, ltaussag, itau, itaussa, itaussag) &