From 4b44917ed0dcd1515d3c007aa72439ec8e54d669 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C3=A9bastien=20Riette?= <sebastien.riette@meteo.fr>
Date: Mon, 27 Jun 2022 11:48:06 +0200
Subject: [PATCH] S. Riette 27/06/2022 Inclusion of ice_adjust test prog
---
build/with_fcm/arch/arch-gnu.fcm | 10 +-
build/with_fcm/fcm-make.cfg | 37 +-
build/with_fcm/make_fcm.sh | 3 +
src/testprogs/ice_adjust/getdata_mod.F90 | 578 +++++++++++++
src/testprogs/ice_adjust/main_ice_adjust.F90 | 369 +++++++++
src/testprogs/ice_adjust/stack_mod.F90 | 26 +
src/testprogs/ice_adjust/xrd_getoptions.F90 | 828 +++++++++++++++++++
src/testprogs/ice_adjust/xrd_unix_env.F90 | 181 ++++
8 files changed, 2011 insertions(+), 21 deletions(-)
create mode 100644 src/testprogs/ice_adjust/getdata_mod.F90
create mode 100644 src/testprogs/ice_adjust/main_ice_adjust.F90
create mode 100644 src/testprogs/ice_adjust/stack_mod.F90
create mode 100644 src/testprogs/ice_adjust/xrd_getoptions.F90
create mode 100644 src/testprogs/ice_adjust/xrd_unix_env.F90
diff --git a/build/with_fcm/arch/arch-gnu.fcm b/build/with_fcm/arch/arch-gnu.fcm
index 5bbff8384..f39016553 100644
--- a/build/with_fcm/arch/arch-gnu.fcm
+++ b/build/with_fcm/arch/arch-gnu.fcm
@@ -1,23 +1,23 @@
# Compilation
$FCOMPILER = gfortran
-$BASE_FFLAGS = -c -fPIC -fdefault-real-8 -fdefault-double-8 -ffree-line-length-none
+$BASE_FFLAGS = -c -fPIC -fdefault-real-8 -fdefault-double-8 -ffree-line-length-none -fopenmp -fconvert=swap
$PROD_FFLAGS = -O3
$DEV_FFLAGS = -O1
$DEBUG_FFLAGS = -check bounds
$CCOMPILER = gcc
-$BASE_CFLAGS = -c -fPIC
+$BASE_CFLAGS = -c -fPIC -fopenmp
$PROD_CFLAGS = -O3
$DEV_CFLAGS = -O1
$DEBUG_CFLAGS = -check bounds
$OMP_FFLAGS =
# Preprocessor
-$FPP_FLAGS = LINUX REPRO48
-$CPP_FLAGS = LINUX
+$FPP_FLAGS = LINUX LITTLE_ENDIAN LITTLE REPRO48
+$CPP_FLAGS = LINUX LITTLE_ENDIAN LITTLE
# Linker
$LINK = gfortran
-$BASE_LD = -fPIC -fdefault-real-8 -fdefault-double-8
+$BASE_LD = -fPIC -fdefault-real-8 -fdefault-double-8 -fopenmp
$OMP_LD =
$LD_EXE_TO_SHARED = -shared
diff --git a/build/with_fcm/fcm-make.cfg b/build/with_fcm/fcm-make.cfg
index b909baed3..ec0b1d1c1 100644
--- a/build/with_fcm/fcm-make.cfg
+++ b/build/with_fcm/fcm-make.cfg
@@ -25,41 +25,46 @@ build.prop{ld} = $LINK
build.prop{ar} = $AR
################################################################################################
-# 3 - TARGET
+# 3 - TARGETS
-#############################
-# 3.1 Target definition to build a static lib
-#build.target = libphyex.a
-#build.target-rename = libo.a:libphyex.a
-
-#############################
-# 3.2 Target definition to build a static lib
+#Target definition to build the testprogs programs and a shared lib
#We need a shared library (.so) but this cannot be build directly with fcm
#The FCM support team says: "FCM doesn’t support building shared libraries."
#We use a dummy program to force fcm to use the linker and we add the needed flags
#to build a shared library instead of a program
-# 3.2.a target is the dummy program but linking is hacked and result is renamed
-build.target = libphyex.so
+#############################
+# 3.1 All programs are built
+build.target{task} = link
+build.prop{fc.flags-ld} = $LD_FLAGS
+
+#############################
+# 3.2 Special options for specific progam
+
+# 3.2.a Special treatment for the shared lib
+#target is the dummy program but linking is hacked and result is renamed
build.target-rename = dummyprog.exe:libphyex.so
-build.prop{fc.flags-ld} = $LD_FLAGS $LD_EXE_TO_SHARED
+build.prop{fc.flags-ld}[libphyex.so] = $LD_FLAGS $LD_EXE_TO_SHARED
+build.prop{dep.o.special}[dummyprog] = $ENTRYPOINTS
+
+# 3.2.b Special treatment for the testprogs
+build.prop{fc.defs}[testprogs] = $FPP_FLAGS WITHOUT_CXXDEMANGLE USE_OPENMP
-# 3.2.b dependencies (internal and external)
+#############################
+# 3.3 dependencies (internal and external)
$util = util1 util2 util3 util4 util5 util6 util7 util8 util9 util10 util11 util12 util13 util14 util15 util16
$mpi = mpi2 mpi3 mpi4 mpi5 mpi6 mpi7 mpi8 mpi9 mpi10 mpi11 mpi12 mpi13 mpi14 mpi15 mpi16 mpi17 mpi18 mpi19
$system = system1 system2 system3 system4 system5 system6 system7 system8 system10 system11 system12 system13 system14
build.prop{ns-dep.o} = common parkind drhook $util $mpi oml mpl gstats1 $system
build.prop{fc.libs} = $LIBS
-# 3.2.c shared lib entry points
-build.prop{dep.o.special} = $ENTRYPOINTS
-
################################################################################################
# 4 - SOURCES
#############################
-# 4.1 Dummy programm to force linking
+# 4.1 Programs and dummy programm to force linking
build.source[dummyprog] = src/dummyprog.F90
+build.source[testprogs] = src/testprogs
#############################
# 4.2 Main directory
diff --git a/build/with_fcm/make_fcm.sh b/build/with_fcm/make_fcm.sh
index 0b6ed7607..b35776607 100755
--- a/build/with_fcm/make_fcm.sh
+++ b/build/with_fcm/make_fcm.sh
@@ -1,5 +1,7 @@
#!/bin/bash
+set -e
+
fcm_version=tags/2021.05.0
fiat_version=1295120464c3905e5edcbb887e4921686653eab8
@@ -182,6 +184,7 @@ cd $builddir
mkdir src
cd src
ln -s ../../../../src/common .
+ln -s ../../../../src/testprogs .
ln -s ../../fiat/src fiat
cat <<EOF > dummyprog.F90
PROGRAM DUMMYPROG
diff --git a/src/testprogs/ice_adjust/getdata_mod.F90 b/src/testprogs/ice_adjust/getdata_mod.F90
new file mode 100644
index 000000000..fa2a6ebcf
--- /dev/null
+++ b/src/testprogs/ice_adjust/getdata_mod.F90
@@ -0,0 +1,578 @@
+MODULE GETDATA_MOD
+
+USE OMP_LIB
+
+INTERFACE REPLICATE
+ MODULE PROCEDURE REPLICATE3
+ MODULE PROCEDURE REPLICATE4
+END INTERFACE
+
+INTERFACE NPROMIZE
+ MODULE PROCEDURE NPROMIZE4
+ MODULE PROCEDURE NPROMIZE5
+END INTERFACE
+
+INTERFACE INTERPOLATE
+ MODULE PROCEDURE INTERPOLATE4
+ MODULE PROCEDURE INTERPOLATE5
+END INTERFACE
+
+INTERFACE SET
+ MODULE PROCEDURE SET3
+ MODULE PROCEDURE SET4
+ MODULE PROCEDURE SET5
+END INTERFACE
+
+CONTAINS
+
+SUBROUTINE GETDATA (NPROMA, NGPBLKS, NFLEVG, PRHODJ_B, PEXNREF_B, PRHODREF_B, PPABSM_B, PTHT_B, ZICE_CLD_WGT_B, &
+& ZSIGQSAT_B, PSIGS_B, PMFCONV_B, PRC_MF_B, PRI_MF_B, PCF_MF_B, PTHS_B, PRS_B, PSRCS_B, PCLDFR_B, PHLC_HRC_B, PHLC_HCF_B, &
+& PHLI_HRI_B, PHLI_HCF_B, ZRS_B, ZZZ_B, PRS_OUT_B, PSRCS_OUT_B, PCLDFR_OUT_B, PHLC_HRC_OUT_B, PHLC_HCF_OUT_B, &
+& PHLI_HRI_OUT_B, PHLI_HCF_OUT_B, LDVERBOSE)
+
+USE IEEE_ARITHMETIC, ONLY : IEEE_SIGNALING_NAN, IEEE_VALUE
+
+IMPLICIT NONE
+
+INTEGER, PARAMETER :: IFILE = 77
+
+INTEGER :: KLON
+INTEGER :: KIDIA
+INTEGER :: KFDIA
+INTEGER :: KLEV
+INTEGER :: KRR
+INTEGER :: KDUM
+
+LOGICAL :: LDVERBOSE
+
+REAL, ALLOCATABLE :: PRHODJ_B (:,:,:,:)
+REAL, ALLOCATABLE :: PEXNREF_B (:,:,:,:)
+REAL, ALLOCATABLE :: PRHODREF_B (:,:,:,:)
+REAL, ALLOCATABLE :: PPABSM_B (:,:,:,:)
+REAL, ALLOCATABLE :: PTHT_B (:,:,:,:)
+REAL, ALLOCATABLE :: ZICE_CLD_WGT_B (:,:,:)
+REAL, ALLOCATABLE :: ZSIGQSAT_B (:,:,:)
+REAL, ALLOCATABLE :: PSIGS_B (:,:,:,:)
+REAL, ALLOCATABLE :: PMFCONV_B (:,:,:,:)
+REAL, ALLOCATABLE :: PRC_MF_B (:,:,:,:)
+REAL, ALLOCATABLE :: PRI_MF_B (:,:,:,:)
+REAL, ALLOCATABLE :: PCF_MF_B (:,:,:,:)
+REAL, ALLOCATABLE :: PTHS_B (:,:,:,:)
+REAL, ALLOCATABLE :: PRS_B (:,:,:,:,:)
+REAL, ALLOCATABLE :: PRS_OUT_B (:,:,:,:,:)
+REAL, ALLOCATABLE :: PSRCS_B (:,:,:,:)
+REAL, ALLOCATABLE :: PSRCS_OUT_B (:,:,:,:)
+REAL, ALLOCATABLE :: PCLDFR_B (:,:,:,:)
+REAL, ALLOCATABLE :: PCLDFR_OUT_B (:,:,:,:)
+REAL, ALLOCATABLE :: PHLC_HRC_B (:,:,:,:)
+REAL, ALLOCATABLE :: PHLC_HRC_OUT_B (:,:,:,:)
+REAL, ALLOCATABLE :: PHLC_HCF_B (:,:,:,:)
+REAL, ALLOCATABLE :: PHLC_HCF_OUT_B (:,:,:,:)
+REAL, ALLOCATABLE :: PHLI_HRI_B (:,:,:,:)
+REAL, ALLOCATABLE :: PHLI_HRI_OUT_B (:,:,:,:)
+REAL, ALLOCATABLE :: PHLI_HCF_B (:,:,:,:)
+REAL, ALLOCATABLE :: PHLI_HCF_OUT_B (:,:,:,:)
+REAL, ALLOCATABLE :: ZRS_B (:,:,:,:,:)
+REAL, ALLOCATABLE :: ZZZ_B (:,:,:,:)
+
+REAL, ALLOCATABLE :: PRHODJ (:,:,:,:)
+REAL, ALLOCATABLE :: PEXNREF (:,:,:,:)
+REAL, ALLOCATABLE :: PRHODREF (:,:,:,:)
+REAL, ALLOCATABLE :: PPABSM (:,:,:,:)
+REAL, ALLOCATABLE :: PTHT (:,:,:,:)
+REAL, ALLOCATABLE :: PSIGS (:,:,:,:)
+REAL, ALLOCATABLE :: PMFCONV (:,:,:,:)
+REAL, ALLOCATABLE :: PRC_MF (:,:,:,:)
+REAL, ALLOCATABLE :: PRI_MF (:,:,:,:)
+REAL, ALLOCATABLE :: PCF_MF (:,:,:,:)
+REAL, ALLOCATABLE :: PTHS (:,:,:,:)
+REAL, ALLOCATABLE :: PRS (:,:,:,:,:)
+REAL, ALLOCATABLE :: PRS_OUT (:,:,:,:,:)
+REAL, ALLOCATABLE :: PSRCS_OUT (:,:,:,:)
+REAL, ALLOCATABLE :: PCLDFR_OUT (:,:,:,:)
+REAL, ALLOCATABLE :: PHLC_HRC_OUT (:,:,:,:)
+REAL, ALLOCATABLE :: PHLC_HCF_OUT (:,:,:,:)
+REAL, ALLOCATABLE :: PHLI_HRI_OUT (:,:,:,:)
+REAL, ALLOCATABLE :: PHLI_HCF_OUT (:,:,:,:)
+REAL, ALLOCATABLE :: ZRS (:,:,:,:,:)
+REAL, ALLOCATABLE :: ZZZ (:,:,:,:)
+
+INTEGER :: NGPTOT, NPROMA, NGPBLKS, NFLEVG
+INTEGER :: IOFF, IBL
+LOGICAL :: LLEXIST
+CHARACTER(LEN=32) :: CLFILE
+REAL :: ZNAN
+
+KRR=6
+NGPTOT = NPROMA * NGPBLKS
+
+IBL = 1
+WRITE (CLFILE, '("data/",I3.3,".dat")') IBL
+OPEN (IFILE, FILE=TRIM (CLFILE), FORM='UNFORMATTED')
+READ (IFILE) KLON, KDUM, KLEV
+CLOSE (IFILE)
+
+IF (NFLEVG < 0) NFLEVG = KLEV
+
+ALLOCATE (ZSIGQSAT_B (NPROMA,1,NGPBLKS))
+ALLOCATE (ZICE_CLD_WGT_B (NPROMA,1,NGPBLKS))
+ALLOCATE (PSRCS_B (NPROMA,1,NFLEVG,NGPBLKS))
+ALLOCATE (PCLDFR_B (NPROMA,1,NFLEVG,NGPBLKS))
+ALLOCATE (PHLC_HRC_B (NPROMA,1,NFLEVG,NGPBLKS))
+ALLOCATE (PHLC_HCF_B (NPROMA,1,NFLEVG,NGPBLKS))
+ALLOCATE (PHLI_HRI_B (NPROMA,1,NFLEVG,NGPBLKS))
+ALLOCATE (PHLI_HCF_B (NPROMA,1,NFLEVG,NGPBLKS))
+ALLOCATE (PRHODJ_B (NPROMA,1,NFLEVG,NGPBLKS))
+ALLOCATE (PEXNREF_B (NPROMA,1,NFLEVG,NGPBLKS))
+ALLOCATE (PRHODREF_B (NPROMA,1,NFLEVG,NGPBLKS))
+ALLOCATE (PPABSM_B (NPROMA,1,NFLEVG,NGPBLKS))
+ALLOCATE (PTHT_B (NPROMA,1,NFLEVG,NGPBLKS))
+ALLOCATE (PSIGS_B (NPROMA,1,NFLEVG,NGPBLKS))
+ALLOCATE (PMFCONV_B (NPROMA,1,NFLEVG,NGPBLKS))
+ALLOCATE (PRC_MF_B (NPROMA,1,NFLEVG,NGPBLKS))
+ALLOCATE (PRI_MF_B (NPROMA,1,NFLEVG,NGPBLKS))
+ALLOCATE (PCF_MF_B (NPROMA,1,NFLEVG,NGPBLKS))
+ALLOCATE (PTHS_B (NPROMA,1,NFLEVG,NGPBLKS))
+ALLOCATE (PRS_B (NPROMA,1,NFLEVG,KRR,NGPBLKS))
+ALLOCATE (PRS_OUT_B (NPROMA,1,NFLEVG,KRR,NGPBLKS))
+ALLOCATE (PSRCS_OUT_B (NPROMA,1,NFLEVG,NGPBLKS))
+ALLOCATE (PCLDFR_OUT_B (NPROMA,1,NFLEVG,NGPBLKS))
+ALLOCATE (ZRS_B (NPROMA,1,NFLEVG,0:KRR,NGPBLKS))
+ALLOCATE (ZZZ_B (NPROMA,1,NFLEVG,NGPBLKS))
+ALLOCATE (PHLC_HRC_OUT_B (NPROMA,1,NFLEVG,NGPBLKS))
+ALLOCATE (PHLC_HCF_OUT_B (NPROMA,1,NFLEVG,NGPBLKS))
+ALLOCATE (PHLI_HRI_OUT_B (NPROMA,1,NFLEVG,NGPBLKS))
+ALLOCATE (PHLI_HCF_OUT_B (NPROMA,1,NFLEVG,NGPBLKS))
+
+ZNAN = IEEE_VALUE (ZNAN, IEEE_SIGNALING_NAN)
+
+
+CALL SET (ZSIGQSAT_B )
+CALL SET (ZICE_CLD_WGT_B)
+CALL SET (PSRCS_B )
+CALL SET (PCLDFR_B )
+CALL SET (PHLC_HRC_B )
+CALL SET (PHLC_HCF_B )
+CALL SET (PHLI_HRI_B )
+CALL SET (PHLI_HCF_B )
+CALL SET (PRHODJ_B )
+CALL SET (PEXNREF_B )
+CALL SET (PRHODREF_B )
+CALL SET (PPABSM_B )
+CALL SET (PTHT_B )
+CALL SET (PSIGS_B )
+CALL SET (PMFCONV_B )
+CALL SET (PRC_MF_B )
+CALL SET (PRI_MF_B )
+CALL SET (PCF_MF_B )
+CALL SET (PTHS_B )
+CALL SET (PRS_B )
+CALL SET (PRS_OUT_B )
+CALL SET (PSRCS_OUT_B )
+CALL SET (PCLDFR_OUT_B )
+CALL SET (ZRS_B )
+CALL SET (ZZZ_B )
+CALL SET (PHLC_HRC_OUT_B)
+CALL SET (PHLC_HCF_OUT_B)
+CALL SET (PHLI_HRI_OUT_B)
+CALL SET (PHLI_HCF_OUT_B)
+
+
+
+ZSIGQSAT_B = 2.0000000000000000E-002
+ZICE_CLD_WGT_B = 1.5
+PSRCS_B = ZNAN
+PCLDFR_B = ZNAN
+PHLI_HCF_B = ZNAN
+PHLI_HRI_B = ZNAN
+PHLC_HCF_B = ZNAN
+PHLC_HRC_B = ZNAN
+
+
+IOFF = 0
+IBL = 1
+
+DO IBL = 1, 296
+ WRITE (CLFILE, '("data/",I3.3,".dat")') IBL
+
+ INQUIRE (FILE=TRIM (CLFILE), EXIST=LLEXIST)
+
+ IF (LDVERBOSE) PRINT *, TRIM (CLFILE)
+
+ IF (.NOT. LLEXIST) EXIT
+
+ OPEN (IFILE, FILE=TRIM (CLFILE), FORM='UNFORMATTED')
+
+ READ (IFILE) KLON, KDUM, KLEV
+
+ IF (IBL == 1) THEN
+ ALLOCATE (PRHODJ (NGPTOT,1,KLEV,1))
+ ALLOCATE (PEXNREF (NGPTOT,1,KLEV,1))
+ ALLOCATE (PRHODREF (NGPTOT,1,KLEV,1))
+ ALLOCATE (PPABSM (NGPTOT,1,KLEV,1))
+ ALLOCATE (PTHT (NGPTOT,1,KLEV,1))
+ ALLOCATE (PSIGS (NGPTOT,1,KLEV,1))
+ ALLOCATE (PMFCONV (NGPTOT,1,KLEV,1))
+ ALLOCATE (PRC_MF (NGPTOT,1,KLEV,1))
+ ALLOCATE (PRI_MF (NGPTOT,1,KLEV,1))
+ ALLOCATE (PCF_MF (NGPTOT,1,KLEV,1))
+ ALLOCATE (PTHS (NGPTOT,1,KLEV,1))
+ ALLOCATE (PRS (NGPTOT,1,KLEV,KRR,1))
+ ALLOCATE (PRS_OUT (NGPTOT,1,KLEV,KRR,1))
+ ALLOCATE (PSRCS_OUT (NGPTOT,1,KLEV,1))
+ ALLOCATE (PCLDFR_OUT (NGPTOT,1,KLEV,1))
+ ALLOCATE (ZRS (NGPTOT,1,KLEV,0:KRR,1))
+ ALLOCATE (ZZZ (NGPTOT,1,KLEV,1))
+ ALLOCATE (PHLC_HRC_OUT (NGPTOT,1,KLEV,1))
+ ALLOCATE (PHLC_HCF_OUT (NGPTOT,1,KLEV,1))
+ ALLOCATE (PHLI_HRI_OUT (NGPTOT,1,KLEV,1))
+ ALLOCATE (PHLI_HCF_OUT (NGPTOT,1,KLEV,1))
+ ENDIF
+
+ IF (IOFF+KLON > NGPTOT) THEN
+ EXIT
+ ENDIF
+
+ READ (IFILE) PRHODJ (IOFF+1:IOFF+KLON,:,:,1)
+ READ (IFILE) PEXNREF (IOFF+1:IOFF+KLON,:,:,1)
+ READ (IFILE) PRHODREF (IOFF+1:IOFF+KLON,:,:,1)
+ READ (IFILE) PSIGS (IOFF+1:IOFF+KLON,:,:,1)
+ READ (IFILE) PMFCONV (IOFF+1:IOFF+KLON,:,:,1)
+ READ (IFILE) PPABSM (IOFF+1:IOFF+KLON,:,:,1)
+ READ (IFILE) ZZZ (IOFF+1:IOFF+KLON,:,:,1)
+ READ (IFILE) PCF_MF (IOFF+1:IOFF+KLON,:,:,1)
+ READ (IFILE) PRC_MF (IOFF+1:IOFF+KLON,:,:,1)
+ READ (IFILE) PRI_MF (IOFF+1:IOFF+KLON,:,:,1)
+ READ (IFILE) ZRS (IOFF+1:IOFF+KLON,:,:,:,1)
+ READ (IFILE) PRS (IOFF+1:IOFF+KLON,:,:,:,1)
+ READ (IFILE) PTHS (IOFF+1:IOFF+KLON,:,:,1)
+ READ (IFILE) PRS_OUT (IOFF+1:IOFF+KLON,:,:,:,1)
+ READ (IFILE) PSRCS_OUT (IOFF+1:IOFF+KLON,:,:,1)
+ READ (IFILE) PCLDFR_OUT (IOFF+1:IOFF+KLON,:,:,1)
+ READ (IFILE) PHLC_HRC_OUT (IOFF+1:IOFF+KLON,:,:,1)
+ READ (IFILE) PHLC_HCF_OUT (IOFF+1:IOFF+KLON,:,:,1)
+ READ (IFILE) PHLI_HRI_OUT (IOFF+1:IOFF+KLON,:,:,1)
+ READ (IFILE) PHLI_HCF_OUT (IOFF+1:IOFF+KLON,:,:,1)
+
+ CLOSE (IFILE)
+
+ IOFF = IOFF + KLON
+
+ENDDO
+
+IF (NFLEVG /= KLEV) THEN
+ CALL INTERPOLATE (NFLEVG, IOFF, PRHODJ )
+ CALL INTERPOLATE (NFLEVG, IOFF, PEXNREF )
+ CALL INTERPOLATE (NFLEVG, IOFF, PRHODREF )
+ CALL INTERPOLATE (NFLEVG, IOFF, PSIGS )
+ CALL INTERPOLATE (NFLEVG, IOFF, PMFCONV )
+ CALL INTERPOLATE (NFLEVG, IOFF, PPABSM )
+ CALL INTERPOLATE (NFLEVG, IOFF, ZZZ )
+ CALL INTERPOLATE (NFLEVG, IOFF, PCF_MF )
+ CALL INTERPOLATE (NFLEVG, IOFF, PRC_MF )
+ CALL INTERPOLATE (NFLEVG, IOFF, PRI_MF )
+ CALL INTERPOLATE (NFLEVG, IOFF, ZRS )
+ CALL INTERPOLATE (NFLEVG, IOFF, PRS )
+ CALL INTERPOLATE (NFLEVG, IOFF, PTHS )
+ CALL INTERPOLATE (NFLEVG, IOFF, PRS_OUT )
+ CALL INTERPOLATE (NFLEVG, IOFF, PSRCS_OUT )
+ CALL INTERPOLATE (NFLEVG, IOFF, PCLDFR_OUT )
+ CALL INTERPOLATE (NFLEVG, IOFF, PHLC_HRC_OUT)
+ CALL INTERPOLATE (NFLEVG, IOFF, PHLC_HCF_OUT)
+ CALL INTERPOLATE (NFLEVG, IOFF, PHLI_HRI_OUT)
+ CALL INTERPOLATE (NFLEVG, IOFF, PHLI_HCF_OUT)
+ENDIF
+
+CALL REPLICATE (IOFF, PRHODJ (:, :, :, 1))
+CALL REPLICATE (IOFF, PEXNREF (:, :, :, 1))
+CALL REPLICATE (IOFF, PRHODREF (:, :, :, 1))
+CALL REPLICATE (IOFF, PSIGS (:, :, :, 1))
+CALL REPLICATE (IOFF, PMFCONV (:, :, :, 1))
+CALL REPLICATE (IOFF, PPABSM (:, :, :, 1))
+CALL REPLICATE (IOFF, ZZZ (:, :, :, 1))
+CALL REPLICATE (IOFF, PCF_MF (:, :, :, 1))
+CALL REPLICATE (IOFF, PRC_MF (:, :, :, 1))
+CALL REPLICATE (IOFF, PRI_MF (:, :, :, 1))
+CALL REPLICATE (IOFF, ZRS (:, :, :, :, 1))
+CALL REPLICATE (IOFF, PRS (:, :, :, :, 1))
+CALL REPLICATE (IOFF, PTHS (:, :, :, 1))
+CALL REPLICATE (IOFF, PRS_OUT (:, :, :, :, 1))
+CALL REPLICATE (IOFF, PSRCS_OUT (:, :, :, 1))
+CALL REPLICATE (IOFF, PCLDFR_OUT (:, :, :, 1))
+CALL REPLICATE (IOFF, PHLC_HRC_OUT (:, :, :, 1))
+CALL REPLICATE (IOFF, PHLC_HCF_OUT (:, :, :, 1))
+CALL REPLICATE (IOFF, PHLI_HRI_OUT (:, :, :, 1))
+CALL REPLICATE (IOFF, PHLI_HCF_OUT (:, :, :, 1))
+
+CALL NPROMIZE (NPROMA, PRHODJ , PRHODJ_B )
+CALL NPROMIZE (NPROMA, PEXNREF , PEXNREF_B )
+CALL NPROMIZE (NPROMA, PRHODREF , PRHODREF_B )
+CALL NPROMIZE (NPROMA, PSIGS , PSIGS_B )
+CALL NPROMIZE (NPROMA, PMFCONV , PMFCONV_B )
+CALL NPROMIZE (NPROMA, PPABSM , PPABSM_B )
+CALL NPROMIZE (NPROMA, ZZZ , ZZZ_B )
+CALL NPROMIZE (NPROMA, PCF_MF , PCF_MF_B )
+CALL NPROMIZE (NPROMA, PRC_MF , PRC_MF_B )
+CALL NPROMIZE (NPROMA, PRI_MF , PRI_MF_B )
+CALL NPROMIZE (NPROMA, ZRS , ZRS_B )
+CALL NPROMIZE (NPROMA, PRS , PRS_B )
+CALL NPROMIZE (NPROMA, PTHS , PTHS_B )
+CALL NPROMIZE (NPROMA, PRS_OUT , PRS_OUT_B )
+CALL NPROMIZE (NPROMA, PSRCS_OUT , PSRCS_OUT_B )
+CALL NPROMIZE (NPROMA, PCLDFR_OUT , PCLDFR_OUT_B )
+CALL NPROMIZE (NPROMA, PHLC_HRC_OUT, PHLC_HRC_OUT_B )
+CALL NPROMIZE (NPROMA, PHLC_HCF_OUT, PHLC_HCF_OUT_B )
+CALL NPROMIZE (NPROMA, PHLI_HRI_OUT, PHLI_HRI_OUT_B )
+CALL NPROMIZE (NPROMA, PHLI_HCF_OUT, PHLI_HCF_OUT_B )
+
+END SUBROUTINE
+
+SUBROUTINE REPLICATE4 (KOFF, P)
+
+INTEGER :: KOFF
+REAL :: P (:,:,:,:)
+
+INTEGER :: I, J
+
+DO I = KOFF+1, SIZE (P, 1)
+ J = 1 + MODULO (I - 1, KOFF)
+ P (I, :, :, :) = P (J, :, :, :)
+ENDDO
+
+END SUBROUTINE
+
+SUBROUTINE REPLICATE3 (KOFF, P)
+
+INTEGER :: KOFF
+REAL :: P (:,:,:)
+
+INTEGER :: I, J
+
+DO I = KOFF+1, SIZE (P, 1)
+ J = 1 + MODULO (I - 1, KOFF)
+ P (I, :, :) = P (J, :, :)
+ENDDO
+
+END SUBROUTINE
+
+SUBROUTINE NPROMIZE4 (KPROMA, PI, PO)
+
+INTEGER :: KPROMA
+REAL, INTENT (IN) :: PI (:,:,:,:)
+REAL, INTENT (OUT) :: PO (:,:,:,:)
+
+INTEGER :: I, J, IGPBLK, IGPTOT, IGP, JLON, JIDIA, JFDIA
+
+IF (SIZE (PI, 4) /= 1) STOP 1
+
+IGPTOT = SIZE (PI, 1)
+IGPBLK = 1 + (IGPTOT-1) / KPROMA
+
+DO IGP = 1, IGPTOT, KPROMA
+ IBL = 1 + (IGP - 1) / KPROMA
+ JIDIA = 1
+ JFDIA = MIN (KPROMA, IGPTOT - (IBL - 1) * KPROMA)
+
+ DO JLON = JIDIA, JFDIA
+ PO (JLON, :, :, IBL) = PI (IGP + (JLON - 1), :, :, 1)
+ ENDDO
+
+ DO JLON = JFDIA+1, KPROMA
+ PO (JLON, :, :, IBL) = PO (JFDIA, :, :, IBL)
+ ENDDO
+
+ENDDO
+
+END SUBROUTINE
+
+SUBROUTINE NPROMIZE5 (KPROMA, PI, PO)
+
+INTEGER :: KPROMA
+REAL, INTENT (IN) :: PI (:,:,:,:,:)
+REAL, INTENT (OUT) :: PO (:,:,:,:,:)
+
+INTEGER :: I, J, IGPBLK, IGPTOT, IGP, JLON, JIDIA, JFDIA
+
+IF (SIZE (PI, 5) /= 1) STOP 1
+
+IGPTOT = SIZE (PI, 1)
+IGPBLK = 1 + (IGPTOT-1) / KPROMA
+
+DO IGP = 1, IGPTOT, KPROMA
+ IBL = 1 + (IGP - 1) / KPROMA
+ JIDIA = 1
+ JFDIA = MIN (KPROMA, IGPTOT - (IBL - 1) * KPROMA)
+
+ DO JLON = JIDIA, JFDIA
+ PO (JLON, :, :, :, IBL) = PI (IGP + (JLON - 1), :, :, :, 1)
+ ENDDO
+
+ DO JLON = JFDIA+1, KPROMA
+ PO (JLON, :, :, :, IBL) = PI (JFDIA, :, :, :, IBL)
+ ENDDO
+
+ENDDO
+
+END SUBROUTINE
+
+SUBROUTINE INTERPOLATE4 (KFLEVG, KOFF, P)
+
+INTEGER :: KFLEVG, KOFF
+REAL, ALLOCATABLE :: P (:,:,:,:)
+REAL :: Z (LBOUND (P, 1):UBOUND (P, 1), &
+ & LBOUND (P, 2):UBOUND (P, 2), &
+ & LBOUND (P, 3):UBOUND (P, 3), &
+ & LBOUND (P, 4):UBOUND (P, 4))
+INTEGER :: ILEV1A, ILEV1B, ILEV2, NLEV1, NLEV2
+REAL :: ZWA, ZWB, ZLEV1, ZLEV2
+
+Z = P
+
+NLEV1 = SIZE (P, 3)
+NLEV2 = KFLEVG
+
+DEALLOCATE (P)
+
+ALLOCATE (P (LBOUND (Z, 1):UBOUND (Z, 1), &
+ & LBOUND (Z, 2):UBOUND (Z, 2), &
+ & KFLEVG, &
+ & LBOUND (Z, 4):UBOUND (Z, 4)))
+
+DO ILEV2 = 1, NLEV2
+ ZLEV2 = REAL (ILEV2 - 1) / REAL (NLEV2 -1)
+ ZLEV1 = 1. + ZLEV2 * REAL (NLEV1 - 1)
+ ILEV1B = MIN (CEILING (ZLEV1), NLEV1)
+ ILEV1A = MAX (FLOOR (ZLEV1), 1)
+
+ IF (ILEV1A == ILEV1B) THEN
+ ZWA = 1.
+ ZWB = 0.
+ ELSE
+ ZWA = REAL (ILEV1B) - ZLEV1
+ ZWB = ZLEV1 - REAL (ILEV1A)
+ ENDIF
+
+! WRITE (*, '(" ZLEV2 = ",E12.5," ZLEV1 = ",E12.5," ILEV2 = ",I4," ILEV1A = ",I4," ZWA = ",E12.5," ILEV1B = ",I4," ZWB = ",E12.5)') &
+! & ZLEV2, ZLEV1, ILEV2, ILEV1A, ZWA, ILEV1B, ZWB
+
+ P (1:KOFF, :, ILEV2, :) = ZWA * Z (1:KOFF, :, ILEV1A, :) + ZWB * Z (1:KOFF, :, ILEV1B, :)
+ENDDO
+
+END SUBROUTINE
+
+SUBROUTINE INTERPOLATE5 (KFLEVG, KOFF, P)
+
+INTEGER :: KFLEVG, KOFF
+REAL, ALLOCATABLE :: P (:,:,:,:,:)
+REAL :: Z (LBOUND (P, 1):UBOUND (P, 1), &
+ & LBOUND (P, 2):UBOUND (P, 2), &
+ & LBOUND (P, 3):UBOUND (P, 3), &
+ & LBOUND (P, 4):UBOUND (P, 4), &
+ & LBOUND (P, 5):UBOUND (P, 5))
+INTEGER :: ILEV1A, ILEV1B, ILEV2, NLEV1, NLEV2
+REAL :: ZWA, ZWB, ZLEV1, ZLEV2
+
+Z = P
+
+NLEV1 = SIZE (P, 3)
+NLEV2 = KFLEVG
+
+DEALLOCATE (P)
+
+ALLOCATE (P (LBOUND (Z, 1):UBOUND (Z, 1), &
+ & LBOUND (Z, 2):UBOUND (Z, 2), &
+ & KFLEVG, &
+ & LBOUND (Z, 4):UBOUND (Z, 4), &
+ & LBOUND (Z, 5):UBOUND (Z, 5)))
+
+DO ILEV2 = 1, NLEV2
+ ZLEV2 = REAL (ILEV2 - 1) / REAL (NLEV2 -1)
+ ZLEV1 = 1. + ZLEV2 * REAL (NLEV1 - 1)
+ ILEV1B = MIN (CEILING (ZLEV1), NLEV1)
+ ILEV1A = MAX (FLOOR (ZLEV1), 1)
+
+ IF (ILEV1A == ILEV1B) THEN
+ ZWA = 1.
+ ZWB = 0.
+ ELSE
+ ZWA = REAL (ILEV1B) - ZLEV1
+ ZWB = ZLEV1 - REAL (ILEV1A)
+ ENDIF
+
+! WRITE (*, '(" ZLEV2 = ",E12.5," ZLEV1 = ",E12.5," ILEV2 = ",I4," ILEV1A = ",I4," ZWA = ",E12.5," ILEV1B = ",I4," ZWB = ",E12.5)') &
+! & ZLEV2, ZLEV1, ILEV2, ILEV1A, ZWA, ILEV1B, ZWB
+
+ P (1:KOFF, :, ILEV2, :, :) = ZWA * Z (1:KOFF, :, ILEV1A, :, :) + ZWB * Z (1:KOFF, :, ILEV1B, :, :)
+ENDDO
+
+END SUBROUTINE
+
+SUBROUTINE SET3 (P)
+
+REAL :: P (:,:,:)
+INTEGER :: IBL, IGPBLKS
+INTEGER :: NTID, ITID, JBLK1, JBLK2
+
+
+IGPBLKS = SIZE (P, 3)
+
+!$OMP PARALLEL PRIVATE (ITID, JBLK1, JBLK2, NTID)
+NTID = OMP_GET_MAX_THREADS ()
+ITID = OMP_GET_THREAD_NUM ()
+JBLK1 = 1 + (IGPBLKS * (ITID+0)) / NTID
+JBLK2 = (IGPBLKS * (ITID+1)) / NTID
+
+DO IBL = JBLK1, JBLK2
+ P (:,:,IBL) = ZNAN
+ENDDO
+
+!$OMP END PARALLEL
+
+END SUBROUTINE
+
+SUBROUTINE SET4 (P)
+
+REAL :: P (:,:,:,:)
+INTEGER :: IBL, IGPBLKS
+INTEGER :: NTID, ITID, JBLK1, JBLK2
+
+IGPBLKS = SIZE (P, 4)
+
+!$OMP PARALLEL PRIVATE (ITID, JBLK1, JBLK2, NTID)
+NTID = OMP_GET_MAX_THREADS ()
+ITID = OMP_GET_THREAD_NUM ()
+JBLK1 = 1 + (IGPBLKS * (ITID+0)) / NTID
+JBLK2 = (IGPBLKS * (ITID+1)) / NTID
+
+DO IBL = JBLK1, JBLK2
+ P (:,:,:,IBL) = ZNAN
+ENDDO
+
+!$OMP END PARALLEL
+
+END SUBROUTINE
+
+SUBROUTINE SET5 (P)
+
+REAL :: P (:,:,:,:,:)
+INTEGER :: IBL, IGPBLKS
+INTEGER :: NTID, ITID, JBLK1, JBLK2
+
+IGPBLKS = SIZE (P, 5)
+
+!$OMP PARALLEL PRIVATE (ITID, JBLK1, JBLK2, NTID)
+NTID = OMP_GET_MAX_THREADS ()
+ITID = OMP_GET_THREAD_NUM ()
+JBLK1 = 1 + (IGPBLKS * (ITID+0)) / NTID
+JBLK2 = (IGPBLKS * (ITID+1)) / NTID
+
+DO IBL = JBLK1, JBLK2
+ P (:,:,:,:,IBL) = ZNAN
+ENDDO
+
+!$OMP END PARALLEL
+
+END SUBROUTINE
+
+
+END MODULE
diff --git a/src/testprogs/ice_adjust/main_ice_adjust.F90 b/src/testprogs/ice_adjust/main_ice_adjust.F90
new file mode 100644
index 000000000..27dd585df
--- /dev/null
+++ b/src/testprogs/ice_adjust/main_ice_adjust.F90
@@ -0,0 +1,369 @@
+PROGRAM MAIN_ICE_ADJUST
+
+USE XRD_GETOPTIONS
+USE GETDATA_MOD
+USE MODI_ICE_ADJUST
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_CST, ONLY: CST_t, CST
+USE MODD_NEB, ONLY: NEB_t, NEB
+USE MODD_RAIN_ICE_PARAM, ONLY : RAIN_ICE_PARAM_t
+USE MODI_INI_CST
+USE MODI_INI_NEB
+USE MODD_BUDGET, ONLY: TBUDGETDATA, NBUDGET_RI, TBUCONF
+USE STACK_MOD
+USE OMP_LIB
+USE YOMHOOK, ONLY : LHOOK, DR_HOOK
+USE PARKIND1, ONLY : JPRB, JPIM
+
+
+IMPLICIT NONE
+
+INTEGER :: KLON
+INTEGER :: KIDIA
+INTEGER :: KFDIA
+INTEGER :: KLEV
+INTEGER :: KRR
+
+REAL, ALLOCATABLE :: PRHODJ (:,:,:,:)
+REAL, ALLOCATABLE :: PEXNREF (:,:,:,:)
+REAL, ALLOCATABLE :: PRHODREF (:,:,:,:)
+REAL, ALLOCATABLE :: PPABSM (:,:,:,:)
+REAL, ALLOCATABLE :: PTHT (:,:,:,:)
+REAL, ALLOCATABLE :: PSIGS (:,:,:,:)
+REAL, ALLOCATABLE :: PMFCONV (:,:,:,:)
+REAL, ALLOCATABLE :: PRC_MF (:,:,:,:)
+REAL, ALLOCATABLE :: PRI_MF (:,:,:,:)
+REAL, ALLOCATABLE :: PCF_MF (:,:,:,:)
+REAL, ALLOCATABLE :: PTHS (:,:,:,:)
+REAL, ALLOCATABLE :: PRS (:,:,:,:,:)
+REAL, ALLOCATABLE :: PSRCS (:,:,:,:)
+REAL, ALLOCATABLE :: PCLDFR (:,:,:,:)
+REAL, ALLOCATABLE :: PHLC_HRC (:,:,:,:)
+REAL, ALLOCATABLE :: PHLC_HCF (:,:,:,:)
+REAL, ALLOCATABLE :: PHLI_HRI (:,:,:,:)
+REAL, ALLOCATABLE :: PHLI_HCF (:,:,:,:)
+REAL, ALLOCATABLE :: ZRS (:,:,:,:,:)
+REAL, ALLOCATABLE :: ZZZ (:,:,:,:)
+REAL, ALLOCATABLE :: ZSIGQSAT (:,:,:)
+REAL, ALLOCATABLE :: ZICE_CLD_WGT (:,:,:)
+
+REAL, ALLOCATABLE :: PRS_OUT (:,:,:,:,:)
+REAL, ALLOCATABLE :: PSRCS_OUT (:,:,:,:)
+REAL, ALLOCATABLE :: PCLDFR_OUT (:,:,:,:)
+REAL, ALLOCATABLE :: PHLC_HRC_OUT (:,:,:,:)
+REAL, ALLOCATABLE :: PHLC_HCF_OUT (:,:,:,:)
+REAL, ALLOCATABLE :: PHLI_HRI_OUT (:,:,:,:)
+REAL, ALLOCATABLE :: PHLI_HCF_OUT (:,:,:,:)
+
+INTEGER :: NPROMA, NGPBLKS, NFLEVG
+INTEGER :: IBL, JLON, JLEV
+
+TYPE(DIMPHYEX_t) :: D, D0
+TYPE(RAIN_ICE_PARAM_t) :: ICEP
+CHARACTER(LEN=1) :: HFRAC_ICE
+CHARACTER(LEN=80) :: HCONDENS
+CHARACTER(LEN=4) :: HLAMBDA3
+CHARACTER(LEN=4) :: HBUNAME
+LOGICAL :: OSUBG_COND
+LOGICAL :: OSIGMAS
+LOGICAL :: OCND2
+LOGICAL :: LMFCONV
+CHARACTER(LEN=80) :: HSUBG_MF_PDF
+REAL :: PTSTEP
+TYPE(TBUDGETDATA), DIMENSION(NBUDGET_RI) :: YLBUDGET
+LOGICAL :: LLCHECK
+LOGICAL :: LLCHECKDIFF
+LOGICAL :: LLDIFF
+INTEGER :: IBLOCK1, IBLOCK2
+INTEGER :: ISTSZ, JBLK1, JBLK2
+INTEGER :: NTID, ITID
+INTEGER :: JRR
+
+REAL, ALLOCATABLE :: PSTACK(:,:)
+TYPE (STACK) :: YLSTACK
+
+REAL(KIND=8) :: TS,TE
+REAL(KIND=8) :: TSC, TEC, TSD, TED, ZTC, ZTD
+INTEGER :: ITIME, NTIME
+INTEGER :: IRANK, ISIZE
+LOGICAL :: LLVERBOSE, LLSTAT, LLBIND
+REAL (KIND=JPRB) :: ZHOOK_HANDLE
+
+CALL INITOPTIONS ()
+NGPBLKS = 296
+CALL GETOPTION ("--blocks", NGPBLKS)
+NPROMA = 32
+CALL GETOPTION ("--nproma", NPROMA)
+NFLEVG = -1
+CALL GETOPTION ("--nflevg", NFLEVG)
+CALL GETOPTION ("--check", LLCHECK)
+CALL GETOPTION ("--checkdiff", LLCHECKDIFF)
+IBLOCK1 = 1
+CALL GETOPTION ("--check-block-1", IBLOCK1)
+IBLOCK2 = NGPBLKS
+CALL GETOPTION ("--check-block-2", IBLOCK2)
+CALL GETOPTION ("--stat", LLSTAT)
+NTIME = 1
+CALL GETOPTION ("--times", NTIME)
+CALL GETOPTION ("--verbose", LLVERBOSE)
+CALL GETOPTION ("--bind", LLBIND)
+CALL CHECKOPTIONS ()
+
+LLDIFF = .FALSE.
+
+IRANK = 0
+ISIZE = 1
+IF (LLBIND) THEN
+ CALL LINUX_BIND (IRANK, ISIZE)
+ CALL LINUX_BIND_DUMP (IRANK, ISIZE)
+ENDIF
+
+CALL GETDATA (NPROMA, NGPBLKS, NFLEVG, PRHODJ, PEXNREF, PRHODREF, PPABSM, PTHT, ZICE_CLD_WGT, &
+& ZSIGQSAT, PSIGS, PMFCONV, PRC_MF, PRI_MF, PCF_MF, PTHS, PRS, PSRCS, PCLDFR, PHLC_HRC, PHLC_HCF, &
+& PHLI_HRI, PHLI_HCF, ZRS, ZZZ, PRS_OUT, PSRCS_OUT, PCLDFR_OUT, PHLC_HRC_OUT, PHLC_HCF_OUT, &
+& PHLI_HRI_OUT, PHLI_HCF_OUT, LLVERBOSE)
+
+
+KLEV = SIZE (PRS, 3)
+KRR = SIZE (PRS, 4)
+
+IF (LLVERBOSE) PRINT *, " KLEV = ", KLEV, " KRR = ", KRR
+
+PRINT *, " NPROMA = ", NPROMA, " KLEV = ", KLEV, " NGPBLKS = ", NGPBLKS
+
+CALL INI_CST
+CALL INI_NEB
+
+! Taken from ini_rain_ice.F90; we only need these for ice_adjust.F90
+ICEP%XCRIAUTI = 0.2E-4
+ICEP%XCRIAUTC = 0.5E-3
+ICEP%XACRIAUTI = 0.06
+ICEP%XBCRIAUTI = -3.5
+
+! As provided by S. Riette, AROME specific
+
+ICEP%XCRIAUTC = 1.0000000000000000E-003
+ICEP%XCRIAUTI = 2.0000000000000001E-004
+ICEP%XACRIAUTI = 6.2974856647312144E-002
+ICEP%XBCRIAUTI = -3.3840957210994582
+
+
+HFRAC_ICE = 'S'
+HCONDENS = 'CB02'
+HLAMBDA3 = 'CB'
+HBUNAME = 'DEPI'
+OSUBG_COND = .TRUE.
+OSIGMAS = .TRUE.
+OCND2 = .FALSE.
+HSUBG_MF_PDF = 'TRIANGLE'
+PTSTEP = 50.000000000000000
+LMFCONV = .TRUE.
+DO JRR=1, NBUDGET_RI
+ YLBUDGET(JRR)%NBUDGET=JRR
+ENDDO
+
+D0%NIT = NPROMA
+D0%NIB = 1
+D0%NIE = NPROMA
+D0%NJT = 1
+D0%NJB = 1
+D0%NJE = 1
+D0%NKL = -1
+D0%NKT = KLEV
+D0%NKA = KLEV
+D0%NKU = 1
+D0%NKB = KLEV
+D0%NKE = 1
+D0%NKTB = 1
+D0%NKTE = KLEV
+
+ISTSZ = NPROMA * 20 * KLEV
+ALLOCATE (PSTACK (ISTSZ, NGPBLKS))
+
+TS = OMP_GET_WTIME ()
+
+ZTD = 0.
+ZTC = 0.
+
+IF (LHOOK) CALL DR_HOOK ('MAIN',0,ZHOOK_HANDLE)
+
+DO ITIME = 1, NTIME
+
+ TSD = OMP_GET_WTIME ()
+
+!$acc data &
+!$acc & copyin (D0, CST, ICEP, NEB, KRR, HFRAC_ICE, HCONDENS, HLAMBDA3, HBUNAME, OSUBG_COND, OSIGMAS, OCND2, HSUBG_MF_PDF, PTSTEP, LMFCONV, &
+!$acc & ZSIGQSAT, PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, PPABSM, ZZZ, PCF_MF, PRC_MF, PRI_MF, ZRS, ZICE_CLD_WGT) &
+!$acc & copy (PRS, PTHS), &
+!$acc & copyout (PSRCS, PCLDFR, PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF) &
+!$acc & create (PSTACK)
+
+ TSC = OMP_GET_WTIME ()
+
+#ifdef USE_OPENMP
+!$OMP PARALLEL PRIVATE (D, ITID, JBLK1, JBLK2)
+#endif
+
+#ifdef _OPENACC
+JBLK1 = 1
+JBLK2 = NGPBLKS
+#endif
+
+#ifdef USE_OPENMP
+NTID = OMP_GET_MAX_THREADS ()
+ITID = OMP_GET_THREAD_NUM ()
+JBLK1 = 1 + (NGPBLKS * (ITID+0)) / NTID
+JBLK2 = (NGPBLKS * (ITID+1)) / NTID
+
+
+!PRINT *, ITID, JBLK1, JBLK2
+
+#endif
+
+!$acc parallel loop gang vector private (YLSTACK, IBL, JLON, D) collapse (2)
+
+ DO IBL = JBLK1, JBLK2
+
+
+#ifdef _OPENACC
+ DO JLON = 1, NPROMA
+ D = D0
+ D%NIB = JLON
+ D%NIE = JLON
+#endif
+
+#ifdef USE_OPENMP
+ D = D0
+#endif
+
+#ifdef USE_STACK
+ YLSTACK%L = LOC (PSTACK (1, IBL))
+ YLSTACK%U = YLSTACK%L + ISTSZ * KIND (PSTACK)
+#else
+ YLSTACK%L = 0
+ YLSTACK%U = 0
+#endif
+
+ CALL ICE_ADJUST (D, CST, ICEP, NEB, TBUCONF, KRR, HFRAC_ICE, HCONDENS, HLAMBDA3, HBUNAME, OSUBG_COND, &
+ & OSIGMAS, OCND2, HSUBG_MF_PDF, PTSTEP, ZSIGQSAT (:, :, IBL), PRHODJ=PRHODJ (:, :, :, IBL), PEXNREF=PEXNREF (:, :, :, IBL), &
+ & PRHODREF=PRHODREF (:, :, :, IBL), PSIGS=PSIGS (:, :, :, IBL), LMFCONV=LMFCONV, PMFCONV=PMFCONV (:, :, :, IBL), &
+ & PPABST=PPABSM (:, :, :, IBL), PZZ=ZZZ (:, :, :, IBL), PEXN=PEXNREF (:, :, :, IBL), PCF_MF=PCF_MF (:, :, :, IBL), &
+ & PRC_MF=PRC_MF (:, :, :, IBL), PRI_MF=PRI_MF (:, :, :, IBL), PRV=ZRS(:, :, :, 1, IBL), PRC=ZRS(:, :, :, 2, IBL), &
+ & PRVS=PRS(:, :, :, 1, IBL), PRCS=PRS(:, :, :, 2, IBL), PTH=ZRS(:, :, :, 0, IBL), PTHS=PTHS (:, :, :, IBL), &
+ & OCOMPUTE_SRC=.TRUE., &
+ & PSRCS=PSRCS (:, :, :, IBL), PCLDFR=PCLDFR (:, :, :, IBL), PRR=ZRS(:, :, :, 3, IBL), PRI=ZRS(:, :, :, 4, IBL), &
+ & PRIS=PRS(:, :, :, 4, IBL), PRS=ZRS(:, :, :, 5, IBL), PRG=ZRS(:, :, :, 6, IBL), PHLC_HRC=PHLC_HRC(:, :, :, IBL), &
+ & PHLC_HCF=PHLC_HCF(:, :, :, IBL), PHLI_HRI=PHLI_HRI(:, :, :, IBL), PHLI_HCF=PHLI_HCF(:, :, :, IBL), &
+ & TBUDGETS=YLBUDGET, KBUDGETS=NBUDGET_RI, &
+ & PICE_CLD_WGT=ZICE_CLD_WGT(:, :, IBL) &
+#ifdef USE_STACK
+ & , YDSTACK=YLSTACK &
+#endif
+ & )
+
+#ifdef _OPENACC
+ ENDDO
+#endif
+
+ ENDDO
+
+#ifdef USE_OPENMP
+!$OMP END PARALLEL
+#endif
+
+!$acc end parallel loop
+
+ TEC = OMP_GET_WTIME ()
+
+!$acc end data
+
+ TED = OMP_GET_WTIME ()
+
+ ZTC = ZTC + (TEC - TSC)
+ ZTD = ZTD + (TED - TSD)
+
+ENDDO
+
+IF (LHOOK) CALL DR_HOOK ('MAIN',1,ZHOOK_HANDLE)
+
+TE = OMP_GET_WTIME()
+
+WRITE (*,'(A,F8.2,A)') 'elapsed time : ',TE-TS,' s'
+WRITE (*,'(A,F8.4,A)') ' i.e. ',1000.*(TE-TS)/(NPROMA*NGPBLKS)/NTIME,' ms/gp'
+
+PRINT *, " ZTD = ", ZTD, ZTD / REAL (NPROMA*NGPBLKS*NTIME)
+PRINT *, " ZTC = ", ZTC, ZTC / REAL (NPROMA*NGPBLKS*NTIME)
+
+
+IF (LLCHECK .OR. LLSTAT .OR. LLCHECKDIFF) THEN
+ DO IBL = IBLOCK1, IBLOCK2
+ PRINT *, " IBL = ", IBL
+ CALL DIFF ("PSRCS", PSRCS_OUT (:,:,:,IBL), PSRCS (:,:,:,IBL))
+ CALL DIFF ("PCLDFR", PCLDFR_OUT (:,:,:,IBL), PCLDFR (:,:,:,IBL))
+ CALL DIFF ("PHLC_HRC", PHLC_HRC_OUT (:,:,:,IBL), PHLC_HRC (:,:,:,IBL))
+ CALL DIFF ("PHLC_HCF", PHLC_HCF_OUT (:,:,:,IBL), PHLC_HCF (:,:,:,IBL))
+ CALL DIFF ("PHLI_HRI", PHLI_HRI_OUT (:,:,:,IBL), PHLI_HRI (:,:,:,IBL))
+ CALL DIFF ("PHLI_HCF", PHLI_HCF_OUT (:,:,:,IBL), PHLI_HCF (:,:,:,IBL))
+ ENDDO
+ENDIF
+
+IF (LLCHECKDIFF) THEN
+ IF (LLDIFF) THEN
+ PRINT*, "THERE ARE DIFF SOMEWHERE"
+ ELSE
+ PRINT*, "THERE IS NO DIFF AT ALL"
+ ENDIF
+ENDIF
+
+STOP
+
+CONTAINS
+
+SUBROUTINE DIFF (CDNAME, PREF, POUT)
+
+CHARACTER (LEN=*) :: CDNAME
+REAL :: PREF (:,:,:)
+REAL :: POUT (:,:,:)
+
+INTEGER :: JLON, JLEV
+
+PRINT *, CDNAME
+IF (LLSTAT) THEN
+ PRINT *, MINVAL (PREF), MAXVAL (PREF), SUM (PREF) / SIZE (PREF)
+ PRINT *, MINVAL (POUT), MAXVAL (POUT), SUM (POUT) / SIZE (POUT)
+ENDIF
+
+IF (LLCHECK) THEN
+ IF (SUM (ABS (POUT) + ABS (PREF)) > 0) THEN
+ WRITE (*, '(A4)', ADVANCE='NO') ""
+ DO JLON = 1, NPROMA
+ WRITE (*, '("|",I12,A12)', ADVANCE='NO') JLON, ""
+ ENDDO
+ WRITE (*, '("|")')
+ DO JLEV = 1, KLEV
+ WRITE (*, '(I4)', ADVANCE='NO') JLEV
+ DO JLON = 1, NPROMA
+ IF (ABS (PREF (JLON, 1, JLEV)) + ABS (POUT (JLON, 1, JLEV)) == 0.) THEN
+ WRITE (*, '("|",2A12)', ADVANCE='NO') "", ""
+ ELSE
+ WRITE (*, '("|",2E12.5)', ADVANCE='NO') PREF (JLON, 1, JLEV), POUT (JLON, 1, JLEV)
+ ENDIF
+ ENDDO
+ WRITE (*, '("|")')
+ ENDDO
+ ENDIF
+ENDIF
+
+IF (LLCHECKDIFF) THEN
+ IF (SUM(ABS(POUT-PREF)) > 0.) THEN
+ PRINT*, "THERE ARE DIFF"
+ LLDIFF = .TRUE.
+ ELSE
+ PRINT*, "THERE IS NO DIFF"
+ ENDIF
+ENDIF
+
+END SUBROUTINE
+
+
+END
diff --git a/src/testprogs/ice_adjust/stack_mod.F90 b/src/testprogs/ice_adjust/stack_mod.F90
new file mode 100644
index 000000000..b02784fb8
--- /dev/null
+++ b/src/testprogs/ice_adjust/stack_mod.F90
@@ -0,0 +1,26 @@
+MODULE STACK_MOD
+
+IMPLICIT NONE
+
+TYPE STACK
+ INTEGER*8 :: L, U
+END TYPE
+
+PRIVATE
+
+PUBLIC :: STACK, SOF
+
+CONTAINS
+
+SUBROUTINE SOF (CDFILE, KLINE)
+!$acc routine (SOF) seq
+
+CHARACTER (LEN=*) :: CDFILE
+INTEGER :: KLINE
+
+PRINT *, 'AT ', CDFILE, ':', KLINE
+STOP 1
+
+END SUBROUTINE
+
+END MODULE
diff --git a/src/testprogs/ice_adjust/xrd_getoptions.F90 b/src/testprogs/ice_adjust/xrd_getoptions.F90
new file mode 100644
index 000000000..0d726c9c0
--- /dev/null
+++ b/src/testprogs/ice_adjust/xrd_getoptions.F90
@@ -0,0 +1,828 @@
+MODULE XRD_GETOPTIONS
+
+!**** *XRD_GETOPTIONS* - Parse command lines options in long form
+
+! Author.
+! -------
+! Philippe Marguinaud *METEO FRANCE*
+! Original : 11-09-2012
+
+USE PARKIND1, ONLY: JPIM, JPRB, JPLM
+
+USE XRD_UNIX_ENV, ONLY: XRD_IARGC, XRD_GETARG, &
+ XRD_BASENAME, XRD_COUNTWORDS, XRD_GETENV, &
+ XRD_ISALPHA, XRD_ISDIGIT, XRD_EXIT
+
+IMPLICIT NONE
+
+INTERFACE GETOPTION
+ MODULE PROCEDURE GETOPTIONS, GETOPTIONSL, &
+ GETOPTIONI, GETOPTIONIL, &
+ GETOPTIONR, GETOPTIONRL, &
+ GETOPTIONB
+
+END INTERFACE
+
+!! @TODO : LIST WITH FIXED SIZE
+
+PUBLIC :: GETOPTION, INITOPTIONS, CHECKOPTIONS, ADDGROUP
+
+INTEGER, PARAMETER :: ARGSIZEMAX = 256
+
+CHARACTER(LEN=ARGSIZEMAX), POINTER :: MYARGS(:) => NULL()
+LOGICAL(KIND=JPLM), POINTER :: CHECK_ARGS(:) => NULL()
+LOGICAL(KIND=JPLM) :: LHELP = .FALSE., LSHELL = .FALSE.
+
+CHARACTER(LEN=1056) :: MESSAGE_OPT = ""
+
+
+TYPE XRD_OPT
+ CHARACTER(LEN=32) :: KEY, TYPE
+ CHARACTER(LEN=1024) :: USE
+ LOGICAL(KIND=JPLM) :: GROUP = .FALSE.
+END TYPE
+
+INTEGER(KIND=JPIM) :: NOPT_SEEN
+TYPE(XRD_OPT), POINTER :: OPT_SEEN(:) => NULL()
+
+PRIVATE
+
+CONTAINS
+
+SUBROUTINE ADDGROUP( USE )
+CHARACTER(LEN=*), INTENT(IN) :: USE
+
+CALL INIT_OPT_SEEN()
+NOPT_SEEN = NOPT_SEEN + 1
+CALL GROW_OPT_SEEN()
+
+OPT_SEEN(NOPT_SEEN)%GROUP = .TRUE.
+OPT_SEEN(NOPT_SEEN)%USE = USE
+
+
+END SUBROUTINE
+
+CHARACTER(LEN=ARGSIZEMAX) FUNCTION GET_ENV_OPT( KEY )
+CHARACTER(LEN=*), INTENT(IN) :: KEY
+CHARACTER(LEN=ARGSIZEMAX) :: KEY_ENV, VAL_ENV
+INTEGER(KIND=JPIM) :: I, N
+CHARACTER :: C
+
+KEY_ENV = KEY(3:)
+
+N = LEN(TRIM(KEY_ENV))
+DO I = 1, N
+ C = KEY_ENV(I:I)
+ IF((.NOT.XRD_ISALPHA(C)) .AND. &
+ (.NOT.XRD_ISDIGIT(C)) .AND. &
+ (C .NE. '_' )) THEN
+ KEY_ENV(I:I) = '_'
+ ENDIF
+ENDDO
+
+VAL_ENV = ""
+CALL XRD_GETENV( 'XRD_OPT_'//TRIM(KEY_ENV), VAL_ENV )
+
+!PRINT *, " KEY = ", TRIM(KEY_ENV), " VAL = ", TRIM(VAL_ENV)
+
+GET_ENV_OPT = VAL_ENV
+
+END FUNCTION
+
+SUBROUTINE MYGETARG( I, S )
+ INTEGER(KIND=JPIM), INTENT(IN) :: I
+ CHARACTER(LEN=*), INTENT(OUT) :: S
+!
+ IF( I .LE. UBOUND( MYARGS, 1 ) ) THEN
+ S = MYARGS(I)
+ ELSE
+ S = ""
+ ENDIF
+END SUBROUTINE
+
+INTEGER FUNCTION MYIARGC()
+ INTEGER :: N
+ N = UBOUND( MYARGS, 1 )
+ MYIARGC = N
+END FUNCTION
+
+SUBROUTINE ADDOPT_SHELL( KEY, TYPE, MND, USE )
+ CHARACTER*(*), INTENT(IN) :: KEY, TYPE, USE
+ LOGICAL(KIND=JPLM), INTENT(IN) :: MND
+ OPTIONAL :: USE, MND
+!
+ CHARACTER(LEN=ARGSIZEMAX) :: STR
+ INTEGER :: NN, N, N1, I1, I2, K
+ CHARACTER(LEN=ARGSIZEMAX), POINTER :: MYARGS1(:)
+
+ MYARGS1 => NULL()
+
+ IF( PRESENT( USE ) ) WRITE( *, '("> ",A)' ) TRIM(USE)
+ IF( PRESENT( MND ) ) THEN
+ IF( MND ) WRITE( *, * ) "[MANDATORY]"
+ ENDIF
+ WRITE( *, * ) "* OPTION: [", TYPE, "]", " ", TRIM(KEY)
+ READ( *, '(A)' ) STR
+
+! PRINT *, "STR = ",TRIM(STR)
+ IF( TRIM(STR) .NE. "" ) THEN
+ IF( TYPE .EQ. 'FLAG' ) THEN
+ NN = 0
+ ELSE
+ NN = XRD_COUNTWORDS( STR )
+ ENDIF
+ N = UBOUND( MYARGS, 1 )
+ N1 = N + NN + 1
+
+!
+! REALLOC MYARGS
+!
+ ALLOCATE( MYARGS1(0:N1) )
+ MYARGS1(0:N) = MYARGS(0:N)
+ DEALLOCATE( MYARGS )
+ MYARGS => MYARGS1
+ MYARGS(N+1) = KEY
+
+!
+! PARSE ARGUMENT LIST
+!
+ IF( TYPE .NE. 'FLAG' ) THEN
+ K = 1
+ I1 = 1
+ LOOP_I1 : DO
+ DO
+ IF( I1 .GT. LEN(STR)) EXIT LOOP_I1
+ IF( STR(I1:I1) .NE. ' ' ) EXIT
+ I1 = I1+1
+ ENDDO
+ I2 = I1+1
+ DO
+ IF( I2 .GT. LEN(STR)) EXIT
+ IF( STR(I2:I2) .EQ. ' ' ) EXIT
+ I2 = I2+1
+ ENDDO
+!PRINT *, I1, I2
+ MYARGS(N+1+K) = STR(I1:I2-1)
+!PRINT *, K, TRIM(MYARGS(N+1+K))
+ K = K+1
+ I1 = I2+1
+ ENDDO LOOP_I1
+ ENDIF
+ ENDIF
+
+END SUBROUTINE
+
+SUBROUTINE INIT_OPT_SEEN()
+
+ IF( .NOT. ASSOCIATED( OPT_SEEN ) ) THEN
+ NOPT_SEEN = 0
+ ALLOCATE( OPT_SEEN( 32 ) )
+ ENDIF
+
+END SUBROUTINE
+
+SUBROUTINE GROW_OPT_SEEN()
+ INTEGER(KIND=JPIM) :: N
+ TYPE(XRD_OPT), POINTER :: OPT_SEEN1(:)
+
+ N = SIZE( OPT_SEEN )
+ IF( NOPT_SEEN .GE. N ) THEN ! REALLOC DATA
+ OPT_SEEN1 => OPT_SEEN
+ ALLOCATE( OPT_SEEN( 2 * N ) )
+ OPT_SEEN(1:NOPT_SEEN) = OPT_SEEN1(1:NOPT_SEEN)
+ DEALLOCATE( OPT_SEEN1 )
+ ENDIF
+
+END SUBROUTINE
+
+SUBROUTINE ADDOPT( KEY, TYPE, USE )
+ CHARACTER*(*), INTENT(IN) :: KEY, TYPE, USE
+ OPTIONAL :: USE
+
+ CALL INIT_OPT_SEEN()
+
+ NOPT_SEEN = NOPT_SEEN + 1
+
+ CALL GROW_OPT_SEEN()
+
+ OPT_SEEN(NOPT_SEEN)%KEY = KEY
+ OPT_SEEN(NOPT_SEEN)%TYPE = TYPE
+
+ IF( PRESENT( USE ) ) THEN
+ OPT_SEEN(NOPT_SEEN)%USE = USE
+ ELSE
+ OPT_SEEN(NOPT_SEEN)%USE = ''
+ ENDIF
+
+END SUBROUTINE
+
+SUBROUTINE INITOPTIONS( CDMESSAGE, KOPTMIN, KOPTMAX, CDARGS )
+ CHARACTER(LEN=*), OPTIONAL, INTENT (IN) :: CDMESSAGE
+ INTEGER (KIND=JPIM), OPTIONAL, INTENT (IN) :: KOPTMIN, KOPTMAX
+ CHARACTER (LEN=*), OPTIONAL, INTENT (IN) :: CDARGS (0:)
+ INTEGER(KIND=JPIM) :: N, I
+ INTEGER(KIND=JPIM) :: IOPTMIN, IOPTMAX
+ CHARACTER*32 :: STR
+
+ IF (PRESENT (CDARGS)) THEN
+ N = UBOUND (CDARGS, 1)
+ ELSE
+ N = XRD_IARGC()
+ ENDIF
+
+ IOPTMIN = 0
+ IOPTMAX = N
+ IF (PRESENT (KOPTMIN)) IOPTMIN = KOPTMIN
+ IF (PRESENT (KOPTMAX)) IOPTMAX = KOPTMAX
+
+ N = IOPTMAX-IOPTMIN
+
+ ALLOCATE( MYARGS(0:N) )
+ DO I = 0, N
+ IF (PRESENT (CDARGS)) THEN
+ MYARGS(I) = CDARGS (IOPTMIN+I)
+ ELSE
+ CALL XRD_GETARG( IOPTMIN+I, MYARGS(I) )
+ ENDIF
+ ENDDO
+
+ IF( PRESENT( CDMESSAGE ) ) THEN
+ MESSAGE_OPT = CDMESSAGE
+ ELSE
+ MESSAGE_OPT = ""
+ ENDIF
+
+ IF( N .EQ. 1 ) THEN
+ CALL MYGETARG( 1_JPIM, STR )
+ IF( TRIM( STR ) .EQ. '--help' ) THEN
+ LHELP = .TRUE.
+ RETURN
+ ELSE IF( TRIM( STR ) .EQ. '--shell' ) THEN
+ LSHELL = .TRUE.
+ RETURN
+ ENDIF
+ ENDIF
+
+ LHELP = .FALSE.
+ ALLOCATE( CHECK_ARGS( N ) )
+ CHECK_ARGS = .FALSE.
+
+END SUBROUTINE
+
+
+
+SUBROUTINE CHECKOPTIONS()
+ INTEGER(KIND=JPIM) :: I, N, IS, NS, KS
+ CHARACTER(LEN=ARGSIZEMAX) :: OPT, PROG
+ LOGICAL(KIND=JPLM) :: PB
+ CHARACTER(LEN=10) :: FMT
+ CHARACTER(LEN=110) :: BUF
+
+ CALL MYGETARG( 0_JPIM, PROG )
+
+ IF( LHELP ) THEN
+ PRINT *, "PROGRAM: ", TRIM(XRD_BASENAME( PROG ))
+ IF( TRIM(MESSAGE_OPT) .NE. "" ) THEN
+ NS = LEN(MESSAGE_OPT)
+ DO IS = 1, NS / 96
+ KS = LEN( TRIM(MESSAGE_OPT(1+(IS-1)*96:IS*96)) )
+ IF( KS .GT. 0 ) THEN
+ IF( IS .EQ. 1 ) THEN
+ WRITE( *, '(" ")', ADVANCE = 'NO' )
+ ELSE
+ WRITE( *, '(" > ")', ADVANCE = 'NO' )
+ ENDIF
+ WRITE( FMT, '("(A",I2,")")' ) KS
+ WRITE( *, FMT ) TRIM(MESSAGE_OPT(1+(IS-1)*96:IS*96))
+ ENDIF
+ ENDDO
+ ENDIF
+ DO I = 1, NOPT_SEEN
+
+ IF(OPT_SEEN(I)%GROUP) THEN
+ WRITE( *, * )
+ IF( TRIM(OPT_SEEN(I)%USE) .NE. "" ) &
+ WRITE( *, * ) '* '//TRIM(OPT_SEEN(I)%USE)
+ CYCLE
+ ENDIF
+
+ BUF = ""
+
+ WRITE( BUF, '(A32," = ",A15)' ) &
+ TRIM(OPT_SEEN(I)%KEY), &
+ TRIM(OPT_SEEN(I)%TYPE)
+
+ IF( TRIM(OPT_SEEN(I)%USE) .NE. '' ) THEN
+ NS = LEN( OPT_SEEN(I)%USE)
+ DO IS = 1, NS / 48
+ KS = LEN(TRIM(OPT_SEEN(I)%USE(1+(IS-1)*48:IS*48)))
+ IF( KS .GT. 0 ) THEN
+ IF( IS .EQ. 1 ) THEN
+ BUF = TRIM(BUF)//" : "//TRIM(OPT_SEEN(I)%USE(1+(IS-1)*48:IS*48))
+ ELSE
+! 000000000011111111112222222222333333333344444444445555555555
+! 012345678901234567890123456789012345678901234567890123456789
+ BUF = " > "&
+ //TRIM(OPT_SEEN(I)%USE(1+(IS-1)*48:IS*48))
+ ENDIF
+ WRITE( *, * ) BUF
+ ENDIF
+ ENDDO
+ ELSE
+ WRITE( *, * ) BUF
+ WRITE( *, * )
+ ENDIF
+
+ ENDDO
+ STOP
+ ELSE IF( ASSOCIATED( CHECK_ARGS ) ) THEN
+ N = SIZE( CHECK_ARGS )
+ PB = .FALSE.
+ DO I = 1, N
+ IF( .NOT. CHECK_ARGS(I) ) THEN
+ CALL MYGETARG( I, OPT )
+ IF( OPT(1:2) .EQ. '--' ) THEN
+ PRINT *, 'INVALID OPTION: ', TRIM(OPT)
+ PB = .TRUE.
+ CHECK_ARGS(I) = .TRUE.
+ ENDIF
+ ENDIF
+ ENDDO
+
+ DO I = 1, N
+ IF( .NOT. CHECK_ARGS(I) ) THEN
+ CALL MYGETARG( I, OPT )
+ PRINT *, 'GARBAGE IN OPTIONS:`', TRIM(OPT), "'"
+ PB = .TRUE.
+ EXIT
+ ENDIF
+ ENDDO
+
+ IF( PB ) CALL XRD_EXIT(1_JPIM)
+
+ DEALLOCATE( CHECK_ARGS )
+ ELSE IF( LSHELL ) THEN
+ OPEN( 77, FILE = TRIM(PROG)//'.sh', FORM = 'FORMATTED' )
+ WRITE( 77, '("#!/bin/sh")' )
+ WRITE( 77, * )
+ WRITE( 77, '(A)', ADVANCE = 'NO' ) TRIM(PROG)
+ N = UBOUND( MYARGS, 1 )
+ DO I = 1, N
+ IF( MYARGS(I) .EQ. '--shell' ) CYCLE
+ IF( MYARGS(I)(1:2) .EQ. '--' ) THEN
+ WRITE( 77, '(" \")' )
+ WRITE( 77, '(" ")', ADVANCE = 'NO' )
+ ENDIF
+ WRITE( 77, '(" ",A)', ADVANCE = 'NO' ) TRIM(MYARGS(I))
+ ENDDO
+ WRITE( 77, * )
+ CLOSE(77)
+ ENDIF
+
+
+
+ IF( ASSOCIATED( OPT_SEEN ) ) DEALLOCATE( OPT_SEEN )
+ IF( ASSOCIATED( MYARGS ) ) DEALLOCATE( MYARGS )
+END SUBROUTINE
+
+
+SUBROUTINE CHECK_MND( KEY, MND, USE )
+ CHARACTER(LEN=*), INTENT(IN) :: KEY
+ CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: USE
+ LOGICAL(KIND=JPLM), OPTIONAL, INTENT(IN) :: MND
+!
+ CHARACTER(LEN=ARGSIZEMAX) :: PROG
+
+ IF( PRESENT( MND ) ) THEN
+ IF( MND ) THEN
+ CALL MYGETARG( 0_JPIM, PROG )
+ WRITE( *, '("PROGRAM: ",(A))' ) TRIM( PROG )
+ WRITE( *, '("ERROR: OPTION `",(A),"'' IS MANDATORY")' ) TRIM( KEY )
+ IF( PRESENT( USE ) ) WRITE( *, '(" ",(A)," : ",(A))' ) TRIM( KEY ), TRIM( USE )
+ CALL XRD_EXIT(1_JPIM)
+ ENDIF
+ ENDIF
+
+END SUBROUTINE
+
+SUBROUTINE FINDARGINDEX( KEY, I, N )
+ CHARACTER(LEN=*), INTENT(IN) :: KEY
+ INTEGER(KIND=JPIM), INTENT(OUT) :: I, N
+ CHARACTER(LEN=ARGSIZEMAX) :: ARG
+
+ N = MYIARGC()
+ DO I = 1, N
+ CALL MYGETARG( I, ARG )
+ IF( TRIM( ARG ) .EQ. TRIM( KEY ) ) RETURN
+ ENDDO
+ I = -1_JPIM
+END SUBROUTINE
+
+SUBROUTINE FINDNEXTARGINDEX( I, J )
+ INTEGER(KIND=JPIM), INTENT(IN) :: I
+ INTEGER(KIND=JPIM), INTENT(OUT) :: J
+!
+ CHARACTER(LEN=ARGSIZEMAX) :: ARG
+ INTEGER(KIND=JPIM) :: N
+
+ N = MYIARGC()
+ DO J = I+1, N
+ CALL MYGETARG( J, ARG )
+ IF( ARG(1:2) .EQ. '--' ) EXIT
+ ENDDO
+
+END SUBROUTINE
+
+SUBROUTINE GETOPTIONS( KEY, VAL, MND, USE )
+!
+ CHARACTER(LEN=*), INTENT(IN) :: KEY
+ CHARACTER(LEN=*), INTENT(INOUT) :: VAL
+ LOGICAL(KIND=JPLM), INTENT(IN), OPTIONAL :: MND
+ CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: USE
+!
+ INTEGER(KIND=JPIM) :: I, N
+ CHARACTER(LEN=ARGSIZEMAX) :: ARG
+ LOGICAL(KIND=JPLM) :: LSHELL1
+ LOGICAL(KIND=JPLM) :: FOUND
+
+ LSHELL1 = LSHELL
+
+ IF( LHELP ) THEN
+ CALL ADDOPT( KEY, 'STRING', USE )
+ RETURN
+ ELSE IF( LSHELL ) THEN
+ LSHELL = .FALSE.
+ CALL ADDOPT_SHELL( KEY, 'STRING', MND, USE )
+ ENDIF
+
+ CALL FINDARGINDEX( KEY, I, N )
+
+ FOUND = ( 0 .LT. I ) .AND. ( I .LT. N )
+
+ IF( FOUND ) THEN
+ IF( ASSOCIATED( CHECK_ARGS ) ) THEN
+ CHECK_ARGS(I) = .TRUE.
+ CHECK_ARGS(I+1) = .TRUE.
+ ENDIF
+ CALL MYGETARG( I+1_JPIM, VAL )
+ ELSE
+ ARG = GET_ENV_OPT( KEY )
+ FOUND = ARG .NE. ""
+ IF( FOUND ) VAL = ARG
+ ENDIF
+
+ IF( .NOT. FOUND ) &
+ CALL CHECK_MND( KEY, MND, USE )
+
+ LSHELL = LSHELL1
+
+END SUBROUTINE
+
+SUBROUTINE GETOPTIONI( KEY, VAL, MND, USE )
+!
+ CHARACTER(LEN=*), INTENT(IN) :: KEY
+ INTEGER(KIND=JPIM), INTENT(INOUT) :: VAL
+ LOGICAL(KIND=JPLM), OPTIONAL, INTENT(IN) :: MND
+ CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: USE
+!
+ CHARACTER(LEN=ARGSIZEMAX) :: SVAL
+ INTEGER :: ERR
+ LOGICAL(KIND=JPLM) :: LSHELL1
+
+ LSHELL1 = LSHELL
+
+ IF( LHELP ) THEN
+ CALL ADDOPT( KEY, 'INTEGER', USE )
+ RETURN
+ ELSE IF( LSHELL ) THEN
+ LSHELL = .FALSE.
+ CALL ADDOPT_SHELL( KEY, 'INTEGER', MND, USE )
+ ENDIF
+
+ SVAL = ""
+ CALL GETOPTIONS( KEY, SVAL, MND, USE )
+ IF( TRIM( SVAL ) .NE. "" ) THEN
+ READ( SVAL, *, IOSTAT = ERR ) VAL
+ IF( ERR .NE. 0 ) THEN
+ PRINT *, "ERROR WHILE PARSING OPTION "//TRIM(KEY)
+ CALL XRD_EXIT(1_JPIM)
+ ENDIF
+ ENDIF
+
+ LSHELL = LSHELL1
+
+END SUBROUTINE
+
+SUBROUTINE GETOPTIONR( KEY, VAL, MND, USE )
+!
+ CHARACTER(LEN=*), INTENT(IN) :: KEY
+ REAL(KIND=JPRB), INTENT(INOUT) :: VAL
+ LOGICAL(KIND=JPLM), OPTIONAL, INTENT(IN) :: MND
+ CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: USE
+!
+ CHARACTER(LEN=ARGSIZEMAX) :: SVAL
+ INTEGER :: ERR
+ LOGICAL(KIND=JPLM) :: LSHELL1
+
+ LSHELL1 = LSHELL
+
+ IF( LHELP ) THEN
+ CALL ADDOPT( KEY, 'REAL', USE )
+ RETURN
+ ELSE IF( LSHELL ) THEN
+ LSHELL = .FALSE.
+ CALL ADDOPT_SHELL( KEY, 'REAL', MND, USE )
+ ENDIF
+
+ SVAL = ""
+ CALL GETOPTIONS( KEY, SVAL, MND, USE )
+ IF( TRIM( SVAL ) .NE. "" ) THEN
+ READ( SVAL, *, IOSTAT = ERR ) VAL
+ IF( ERR .NE. 0 ) THEN
+ PRINT *, "ERROR WHILE PARSING OPTION "//TRIM(KEY)
+ CALL XRD_EXIT(1_JPIM)
+ ENDIF
+ ENDIF
+
+ LSHELL = LSHELL1
+
+END SUBROUTINE
+
+SUBROUTINE READASLFROMSTRING( VAL, SVAL )
+ CHARACTER(LEN=*), INTENT(OUT) :: VAL(:)
+ CHARACTER(LEN=*), INTENT(IN) :: SVAL
+!
+ INTEGER(KIND=JPIM) :: I, J, K, N
+
+ N = LEN( SVAL )
+
+ I = 1
+ K = 1
+ DO1 : DO
+ DO
+ IF( I .GT. N ) EXIT DO1
+ IF( SVAL(I:I) .NE. ' ' ) EXIT
+ I = I + 1
+ ENDDO
+ J = I
+ DO
+ IF( J .GT. N ) EXIT
+ IF( SVAL(J:J) .EQ. ' ' ) EXIT
+ J = J + 1
+ ENDDO
+
+ VAL(K) = SVAL(I:J-1)
+ I = J
+ K = K + 1
+ ENDDO DO1
+
+
+END SUBROUTINE
+
+SUBROUTINE READSLFROMSTRING( VAL, SVAL )
+ CHARACTER(LEN=*), POINTER :: VAL(:)
+ CHARACTER(LEN=*), INTENT(IN) :: SVAL
+!
+ INTEGER(KIND=JPIM) :: N
+
+ N = XRD_COUNTWORDS( SVAL )
+ ALLOCATE( VAL( N ) )
+
+ CALL READASLFROMSTRING( VAL, SVAL )
+
+END SUBROUTINE
+
+SUBROUTINE READSLFROMFILE( VAL, SVAL )
+ CHARACTER(LEN=*), POINTER :: VAL(:)
+ CHARACTER(LEN=*), INTENT(IN) :: SVAL
+!
+ INTEGER(KIND=JPIM) :: K, N
+ INTEGER(KIND=JPIM) :: IOERR
+ CHARACTER(LEN=4096) :: BUFFER
+
+ OPEN( 77, FILE = TRIM(SVAL), FORM = 'FORMATTED', STATUS = 'OLD', IOSTAT = IOERR )
+ IF( IOERR .NE. 0 ) THEN
+ PRINT '( "COULD NOT OPEN ",A, " FOR READING")', TRIM(SVAL)
+ CALL XRD_EXIT(1_JPIM)
+ ENDIF
+ N = 0_JPIM
+ DO
+ READ( 77, '(A)', END = 500 ) BUFFER
+ N = N + XRD_COUNTWORDS( BUFFER )
+ ENDDO
+
+ 500 CONTINUE
+
+ REWIND( 77 )
+
+ ALLOCATE( VAL( N ) )
+
+ K = 1
+ DO
+ READ( 77, '(A)', END = 600 ) BUFFER
+ N = XRD_COUNTWORDS( BUFFER )
+ CALL READASLFROMSTRING( VAL(K:K+N-1), BUFFER )
+ K = K + N
+ ENDDO
+
+ 600 CONTINUE
+
+
+ CLOSE( 77 )
+
+END SUBROUTINE
+
+SUBROUTINE GETOPTIONSL( KEY, VAL, MND, USE )
+!
+ CHARACTER(LEN=*), INTENT(IN) :: KEY
+ CHARACTER(LEN=*), POINTER :: VAL(:)
+ LOGICAL(KIND=JPLM), OPTIONAL, INTENT(IN) :: MND
+ CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: USE
+!
+ INTEGER(KIND=JPIM) :: I, J, K, N
+ CHARACTER(LEN=ARGSIZEMAX) :: ARG
+ CHARACTER(LEN=ARGSIZEMAX) :: SVAL
+ LOGICAL(KIND=JPLM) :: LSHELL1
+ LOGICAL(KIND=JPLM) :: FOUND
+
+ LSHELL1 = LSHELL
+
+ IF( LHELP ) THEN
+ CALL ADDOPT( KEY, 'STRING-LIST', USE )
+ RETURN
+ ELSE IF( LSHELL ) THEN
+ LSHELL = .FALSE.
+ CALL ADDOPT_SHELL( KEY, 'STRING-LIST', MND, USE )
+ ENDIF
+
+ CALL FINDARGINDEX( KEY, I, N )
+
+ FOUND = I >= 0
+
+ IF( FOUND ) THEN
+
+ CALL FINDNEXTARGINDEX( I, J )
+
+ ALLOCATE( VAL( J - I - 1 ) )
+
+ IF( ASSOCIATED( CHECK_ARGS ) ) &
+ CHECK_ARGS(I) = .TRUE.
+
+ DO K = I+1, J-1
+ IF( ASSOCIATED( CHECK_ARGS ) ) &
+ CHECK_ARGS(K) = .TRUE.
+ CALL MYGETARG( K, ARG )
+ IF ((I+1.EQ.J-1) .AND. (ARG(1:7).EQ.'file://')) THEN
+ DEALLOCATE (VAL)
+ ARG = ARG(8:)
+ CALL READSLFROMFILE( VAL, ARG )
+ ELSE
+ VAL(K-I) = ARG
+ ENDIF
+ ENDDO
+
+ ENDIF
+
+ IF(.NOT. FOUND) THEN
+ SVAL = GET_ENV_OPT( KEY )
+ FOUND = SVAL .NE. ""
+ IF( FOUND ) &
+ CALL READSLFROMSTRING( VAL, SVAL )
+ ENDIF
+
+ IF( .NOT. FOUND ) &
+ CALL CHECK_MND( KEY, MND, USE )
+
+ LSHELL = LSHELL1
+
+END SUBROUTINE
+
+SUBROUTINE GETOPTIONIL( KEY, VAL, MND, USE )
+!
+ CHARACTER(LEN=*), INTENT(IN) :: KEY
+ INTEGER(KIND=JPIM), POINTER :: VAL(:)
+ LOGICAL(KIND=JPLM), OPTIONAL, INTENT(IN) :: MND
+ CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: USE
+!
+ CHARACTER(LEN=ARGSIZEMAX), POINTER :: SVAL(:)
+ INTEGER(KIND=JPIM) :: I, N
+ INTEGER :: ERR
+ LOGICAL(KIND=JPLM) :: LSHELL1
+
+ NULLIFY (SVAL)
+
+ LSHELL1 = LSHELL
+
+ IF( LHELP ) THEN
+ CALL ADDOPT( KEY, 'INTEGER-LIST', USE )
+ RETURN
+ ELSE IF( LSHELL ) THEN
+ LSHELL = .FALSE.
+ CALL ADDOPT_SHELL( KEY, 'INTEGER-LIST', MND, USE )
+ ENDIF
+
+ CALL GETOPTIONSL( KEY, SVAL, MND, USE )
+
+ IF( .NOT. ASSOCIATED( SVAL ) ) GOTO 999
+
+ N = SIZE( SVAL )
+ ALLOCATE( VAL( N ) )
+ DO I = 1, N
+ READ( SVAL( I ), *, IOSTAT = ERR ) VAL( I )
+ IF( ERR .NE. 0 ) THEN
+ PRINT *, "ERROR WHILE PARSING OPTION "//TRIM(KEY)
+ CALL XRD_EXIT(1_JPIM)
+ ENDIF
+ ENDDO
+
+ DEALLOCATE( SVAL )
+
+999 CONTINUE
+ LSHELL = LSHELL1
+
+END SUBROUTINE
+
+SUBROUTINE GETOPTIONRL( KEY, VAL, MND, USE )
+!
+ CHARACTER(LEN=*), INTENT(IN) :: KEY
+ REAL(KIND=JPRB), POINTER :: VAL(:)
+ LOGICAL(KIND=JPLM), OPTIONAL, INTENT(IN) :: MND
+ CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: USE
+!
+ CHARACTER(LEN=ARGSIZEMAX), POINTER :: SVAL(:)
+ INTEGER(KIND=JPIM) :: I, N
+ INTEGER :: ERR
+ LOGICAL(KIND=JPLM) :: LSHELL1
+
+ NULLIFY (SVAL)
+
+ LSHELL1 = LSHELL
+
+ IF( LHELP ) THEN
+ CALL ADDOPT( KEY, 'REAL-LIST', USE )
+ RETURN
+ ELSE IF( LSHELL ) THEN
+ LSHELL = .FALSE.
+ CALL ADDOPT_SHELL( KEY, 'REAL-LIST', MND, USE )
+ ENDIF
+
+ CALL GETOPTIONSL( KEY, SVAL, MND, USE )
+
+ IF( .NOT. ASSOCIATED( SVAL ) ) GOTO 999
+
+ N = SIZE( SVAL )
+ ALLOCATE( VAL( N ) )
+ DO I = 1, N
+ READ( SVAL( I ), *, IOSTAT = ERR ) VAL( I )
+ IF( ERR .NE. 0 ) THEN
+ PRINT *, "ERROR WHILE PARSING OPTION "//TRIM(KEY)
+ CALL XRD_EXIT(1_JPIM)
+ ENDIF
+ ENDDO
+
+ DEALLOCATE( SVAL )
+
+999 CONTINUE
+ LSHELL = LSHELL1
+
+END SUBROUTINE
+
+SUBROUTINE GETOPTIONB( KEY, VAL, USE )
+!
+ CHARACTER(LEN=*), INTENT(IN) :: KEY
+ LOGICAL(KIND=JPLM), INTENT(INOUT) :: VAL
+ CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: USE
+!
+ LOGICAL(KIND=JPLM) :: LSHELL1
+ LOGICAL(KIND=JPLM) :: FOUND
+ CHARACTER(LEN=ARGSIZEMAX) :: SVAL
+ INTEGER(KIND=JPIM) :: I, N
+
+ LSHELL1 = LSHELL
+
+ VAL = .FALSE.
+
+ IF( LHELP ) THEN
+ CALL ADDOPT( KEY, 'FLAG', USE )
+ RETURN
+ ELSE IF( LSHELL ) THEN
+ LSHELL = .FALSE.
+ CALL ADDOPT_SHELL( KEY, 'FLAG', .FALSE._JPLM, USE )
+ ENDIF
+
+ CALL FINDARGINDEX( KEY, I, N )
+ FOUND = I > 0
+ IF( FOUND .AND. ASSOCIATED( CHECK_ARGS ) ) THEN
+ CHECK_ARGS(I) = .TRUE.
+ VAL = .TRUE.
+ ELSE
+ SVAL = GET_ENV_OPT( KEY )
+ IF( SVAL .NE. "" ) &
+ READ( SVAL, * ) VAL
+ ENDIF
+
+ LSHELL = LSHELL1
+
+END SUBROUTINE
+
+END MODULE
diff --git a/src/testprogs/ice_adjust/xrd_unix_env.F90 b/src/testprogs/ice_adjust/xrd_unix_env.F90
new file mode 100644
index 000000000..c689c6255
--- /dev/null
+++ b/src/testprogs/ice_adjust/xrd_unix_env.F90
@@ -0,0 +1,181 @@
+MODULE XRD_UNIX_ENV
+
+!**** *XRD_UNIX_ENV* -
+
+! Author.
+! -------
+! Philippe Marguinaud *METEO FRANCE*
+! Original : 11-09-2012
+
+USE PARKIND1, ONLY : JPIM, JPRB, JPLM
+IMPLICIT NONE
+
+CONTAINS
+
+SUBROUTINE XRD_GETENV( KEY, VAL )
+ IMPLICIT NONE
+ CHARACTER(LEN=*), INTENT(IN) :: KEY
+ CHARACTER(LEN=*), INTENT(OUT) :: VAL
+
+ CALL GET_ENVIRONMENT_VARIABLE( KEY, VAL )
+END SUBROUTINE
+
+
+FUNCTION XRD_IARGC()
+ IMPLICIT NONE
+ INTEGER(KIND=JPIM) :: XRD_IARGC
+ XRD_IARGC = COMMAND_ARGUMENT_COUNT()
+END FUNCTION
+
+SUBROUTINE XRD_GETARG( KEY, VAL )
+ IMPLICIT NONE
+ INTEGER(KIND=JPIM), INTENT(IN) :: KEY
+ CHARACTER(LEN=*), INTENT(OUT) :: VAL
+ CALL GETARG( INT(KEY,SELECTED_INT_KIND(9)), VAL )
+END SUBROUTINE
+
+SUBROUTINE XRD_EXIT( STATUS )
+ IMPLICIT NONE
+ INTEGER(KIND=JPIM), INTENT(IN) :: STATUS
+ CALL EXIT( INT(STATUS,SELECTED_INT_KIND(9)) )
+END SUBROUTINE
+
+SUBROUTINE XRD_MKDIR( PATH )
+ IMPLICIT NONE
+ CHARACTER(LEN=*), INTENT(IN) :: PATH
+ CALL SYSTEM( "mkdir -p "//TRIM(PATH))
+END SUBROUTINE
+
+CHARACTER*256 FUNCTION XRD_DIRNAME( PATH )
+ IMPLICIT NONE
+ CHARACTER(LEN=*), INTENT(IN) :: PATH
+
+ INTEGER(KIND=JPIM) :: I
+ XRD_DIRNAME = ""
+ I = LEN( TRIM( PATH ) ) - 1
+ DO
+ IF( I .LE. 0 ) RETURN
+ IF( PATH(I:I) .EQ. '/' ) EXIT
+ I = I - 1
+ ENDDO
+ XRD_DIRNAME = PATH(1:I)
+END FUNCTION
+
+FUNCTION XRD_BASENAME( PATH )
+ IMPLICIT NONE
+ CHARACTER*256 :: XRD_BASENAME
+ CHARACTER(LEN=*), INTENT(IN) :: PATH
+
+ INTEGER(KIND=JPIM) :: I
+ XRD_BASENAME = ""
+ I = LEN( TRIM( PATH ) ) - 1
+ DO
+ IF( I .LE. 0 ) THEN
+ I = 0
+ EXIT
+ ENDIF
+ IF( PATH(I:I) .EQ. '/' ) EXIT
+ I = I - 1
+ ENDDO
+ XRD_BASENAME = PATH(I+1:)
+END FUNCTION
+
+ELEMENTAL SUBROUTINE XRD_LOWER_CASE(OUS,INS)
+IMPLICIT NONE
+! CONVERT A WORD TO LOWER CASE
+CHARACTER (LEN=*) , INTENT(OUT) :: OUS
+CHARACTER (LEN=*) , INTENT(IN) :: INS
+INTEGER :: I,IC,NLEN
+NLEN = LEN(INS)
+OUS = ''
+DO I=1,NLEN
+ IC = ICHAR(INS(I:I))
+ IF (IC >= 65 .AND. IC < 90) THEN
+ OUS(I:I) = CHAR(IC+32)
+ ELSE
+ OUS(I:I) = INS(I:I)
+ ENDIF
+END DO
+END SUBROUTINE XRD_LOWER_CASE
+
+FUNCTION XRD_ISALPHA(C)
+IMPLICIT NONE
+LOGICAL(KIND=JPLM) :: XRD_ISALPHA
+CHARACTER, INTENT(IN) :: C
+
+XRD_ISALPHA = ((C.GE.'A').AND.(C.LE.'Z'))&
+ .OR.((C.GE.'a').AND.(C.LE.'z'))
+
+END FUNCTION
+
+FUNCTION XRD_ISDIGIT(C)
+IMPLICIT NONE
+LOGICAL(KIND=JPLM) :: XRD_ISDIGIT
+CHARACTER, INTENT(IN) :: C
+
+XRD_ISDIGIT = (C.GE.'0').AND.(C.LE.'9')
+
+END FUNCTION
+
+SUBROUTINE XRD_DATE_AND_TIME( VL )
+IMPLICIT NONE
+INTEGER(KIND=JPIM), INTENT(OUT) :: VL(8)
+!
+INTEGER :: VLX(8)
+
+ CALL DATE_AND_TIME( VALUES = VLX )
+
+ VL = VLX
+END SUBROUTINE
+
+SUBROUTINE XRD_CPU_TIME( T )
+ IMPLICIT NONE
+ REAL,INTENT(OUT) :: T
+ CALL CPU_TIME( T )
+END SUBROUTINE
+
+SUBROUTINE XRD_COUNTLINES( NLINES, F, ERR )
+IMPLICIT NONE
+INTEGER(KIND=JPIM), INTENT(OUT) :: NLINES
+CHARACTER*(*), INTENT(IN) :: F
+INTEGER(KIND=JPIM), INTENT(OUT) :: ERR
+CHARACTER*32 :: STR
+
+NLINES = 0
+OPEN( 77, FILE = F, ERR = 888 )
+
+DO
+ READ( 77, *, ERR = 888, END = 777 ) STR
+ NLINES = NLINES + 1
+ENDDO
+
+777 CONTINUE
+
+CLOSE( 77 )
+
+RETURN
+888 CONTINUE
+ ERR = 1
+END SUBROUTINE
+
+FUNCTION XRD_COUNTWORDS( S )
+ IMPLICIT NONE
+ INTEGER(KIND=JPIM) :: XRD_COUNTWORDS
+ CHARACTER(LEN=*), INTENT(IN) :: S
+ INTEGER(KIND=JPIM) :: N, I, L
+ LOGICAL(KIND=JPLM) :: IN
+ N = 0_JPIM
+ IN = .FALSE.
+ L = LEN( TRIM( S ) )
+ DO I = 1, L
+ IF( S(I:I) .EQ. ' ' ) THEN
+ IN = .FALSE.
+ ELSE IF( .NOT. IN ) THEN
+ N = N + 1
+ IN = .TRUE.
+ ENDIF
+ ENDDO
+ XRD_COUNTWORDS = N
+END FUNCTION
+
+END MODULE
--
GitLab